|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
参与一下。。。- Sub ykcbf() '//2023.12.17
- Dim arr, zrr, d
- Set d = CreateObject("Scripting.Dictionary")
- With Sheets("表1")
- r1 = .Cells(Rows.Count, "q").End(3).Row
- zrr = .Range("p1:t" & r1)
- r = .Cells(Rows.Count, 1).End(3).Row
- arr = .Range("a3:m" & r)
- End With
- For i = 3 To UBound(zrr)
- If zrr(i, 1) = "有数据" Then
- s = zrr(i, 2)
- d(s) = Array(zrr(i, 3), zrr(i, 4), zrr(i, 5))
- End If
- Next
- For i = 1 To UBound(arr)
- s = arr(i, 9)
- If d.exists(s) Then
- For j = 11 To 13
- arr(i, j) = d(s)(j - 11)
- Next
- End If
- Next
- With Sheets("表2")
- .[a3].Resize(UBound(arr), UBound(arr, 2)) = arr
- End With
- Set d = Nothing
- MsgBox "OK!"
- End Sub
复制代码
|
|