|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
参与一下。。。- Sub ykcbf() '//2024.3.19
- Dim arr, d
- Application.ScreenUpdating = False
- Set d = CreateObject("Scripting.Dictionary")
- p = ThisWorkbook.Path
- f = p & "\数据表.xlsx"
- Set sh = ThisWorkbook.Sheets(1)
- brr = sh.[a1].Resize(10000, 7)
- For j = 1 To UBound(brr, 2)
- s = brr(2, j)
- d(s) = j
- Next
- Set wb = Workbooks.Open(f, 0)
- With wb.Sheets(1)
- arr = .UsedRange
- wb.Close 0
- End With
- For i = 3 To UBound(arr)
- For j = 1 To UBound(arr, 2)
- s = arr(2, j)
- If d.exists(s) Then
- brr(i, d(s)) = arr(i, j)
- End If
- Next
- Next
- With sh
- .UsedRange.Offset(2) = ""
- .[a1].Resize(UBound(arr), 7) = brr
- .[a1].Resize(UBound(arr), 7).Borders.LineStyle = 1
- End With
- Set d = Nothing
- Application.ScreenUpdating = True
- MsgBox "OK!"
- End Sub
复制代码
|
|