|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub test()
- Dim r%, i%
- Dim arr, brr
- Dim d As Object
- Set d = CreateObject("scripting.dictionary")
- With Worksheets("report")
- r = .Cells(.Rows.Count, 1).End(xlUp).Row
- arr = .Range("a2:n" & r)
- End With
- For i = 1 To UBound(arr)
- If arr(i, 5) = "LJ" Or arr(i, 5) = "TJ" Then
- If Not d.exists(arr(i, 9)) Then
- ReDim brr(1 To 4)
- brr(1) = arr(i, 9)
- Else
- brr = d(arr(i, 9))
- End If
- brr(2) = brr(2) + arr(i, 8)
- brr(3) = brr(3) + arr(i, 13)
- d(arr(i, 9)) = brr
- End If
- Next
- With Worksheets("sheet1")
- r = .Cells(.Rows.Count, 1).End(xlUp).Row
- arr = .Range("a3:d" & r)
- For i = 1 To UBound(arr)
- If d.exists(arr(i, 1)) Then
- brr = d(arr(i, 1))
- For j = 1 To UBound(brr)
- arr(i, j) = brr(j)
- Next
- End If
- Next
- .Range("a3:d" & r) = arr
- End With
-
- End Sub
复制代码 |
|