|
- Sub test()
- Dim r%, i%
- Dim arr, brr
- Dim d As Object
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- Set d1 = CreateObject("scripting.dictionary")
- Set d2 = CreateObject("scripting.dictionary")
- With Worksheets("sheet2")
- .AutoFilterMode = False
- r = .Cells(.Rows.Count, 1).End(xlUp).Row
- c = .Cells(2, .Columns.Count).End(xlToLeft).Column
- .Range("b3").Resize(r - 2, c - 1).ClearContents
- brr = .Range("a2:g" & r)
- For i = 2 To UBound(brr)
- d1(brr(i, 1)) = i
- Next
- For j = 2 To UBound(brr, 2) - 1
- d2(brr(1, j)) = j
- Next
- End With
- With Worksheets("sheet1")
- .AutoFilterMode = False
- r = .Cells(.Rows.Count, 1).End(xlUp).Row
- arr = .Range("a3:d" & r)
- For i = 1 To UBound(arr)
- If d1.exists(arr(i, 1)) Then
- m = d1(arr(i, 1))
- If d2.exists(arr(i, 2)) Then
- n = d2(arr(i, 2))
- brr(m, n) = arr(i, 3)
- End If
- brr(m, UBound(brr, 2)) = arr(i, 4)
- End If
- Next
- End With
- With Worksheets("sheet2")
- .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
- End With
- End Sub
复制代码 |
|