- Sub test()
- Set d = CreateObject("scripting.dictionary")
- arr = Sheets(1).UsedRange
- Application.ScreenUpdating = False
- Sheets(2).Select
- ActiveSheet.UsedRange.Offset(1).ClearContents
- For j = 2 To UBound(arr)
- If d.exists(arr(j, 8)) Then
- r = d(arr(j, 8))
- Cells(r, 7) = Cells(r, 7) + arr(j, 10)
- c = Cells(r, Columns.Count).End(xlToLeft).Column + 1
- Cells(r, c) = arr(j, 5)
- Cells(r, c + 1) = arr(j, 6)
- Cells(r, c + 2) = arr(j, 9)
- Cells(r, c + 3) = arr(j, 10)
- Else
- r = Cells(Rows.Count, 1).End(3).Row + 1
- d(arr(j, 8)) = r
- For i = 1 To 4
- Cells(r, i) = arr(j, i)
- Next
- Cells(r, 5) = arr(j, 8)
- Cells(r, 6) = arr(j, 7)
- Cells(r, 7) = arr(j, 10)
- Cells(r, 8) = arr(j, 5)
- Cells(r, 9) = arr(j, 6)
- Cells(r, 10) = arr(j, 9)
- Cells(r, 11) = arr(j, 10)
- End If
- Next j
- Application.ScreenUpdating = True
- End Sub
复制代码 |