|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
代码如下。。。
Sub test()
Dim brr
arr = Sheet1.UsedRange
For j = 2 To UBound(arr, 2)
If arr(1, j) = Empty Then arr(1, j) = arr(1, j - 1)
Next
Set d = CreateObject("scripting.dictionary")
With Sheet2
s = .[c1] & "|"
brr = .Range("a1").Resize(.Cells(.Rows.Count, 1).End(3).Row, 6)
n = 0
For i = 3 To UBound(brr)
n = n + 1
d(brr(i, 1)) = n
Next
n = 0
For i = 2 To UBound(brr, 2)
n = n + 1
d(brr(2, i)) = n
Next
ReDim brr(1 To UBound(brr) - 2, 1 To UBound(brr, 2) - 1)
For i = 3 To UBound(arr)
For j = 2 To UBound(arr, 2)
If InStr(arr(i, j) & "|", s) Then
If arr(i, 1) = "早读" Or arr(i, 1) = "延时服务" Then
brr(d(arr(i, 1)), d(arr(1, j))) = arr(2, j)
Else
brr(d(arr(i, 1)), d(arr(1, j))) = arr(2, j) & vbCrLf & Split(arr(i, j), Chr(10))(0)
End If
End If
Next
Next
.Range("a1").Offset(2, 1).Resize(.Cells(.Rows.Count, 1).End(3).Row - 2, 5) = brr
End With
Set d = Nothing
Beep
End Sub
|
|