- ©«¤l
- 976
- ¥DÃD
- 7
- ºëµØ
- 0
- ¿n¤À
- 1018
- ÂI¦W
- 0
- §@·~¨t²Î
- Win10
- ³nÅ骩¥»
- Office 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2013-4-19
- ³Ì«áµn¿ý
- 2024-12-18
|
¥»©«³Ì«á¥Ñ samwang ©ó 2021-5-16 21:03 ½s¿è
¦^´_ 1# stephenlee
½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, xD, Ar(), T, UT, T2%, T3%, i&, M%, N%
Set xD = CreateObject("Scripting.Dictionary")
R = [a65536].End(3).Row + 1
Arr = Range("a1:g" & R)
For i = 2 To UBound(Arr)
T = Arr(i, 4): T2 = Arr(i, 5): T3 = Arr(i, 6): UT = Arr(i - 1, 4)
If T = "" And UT <> "" Then GoTo 98
If T = "" Then GoTo 99
If xD.Exists(T & "") Then
M = xD(T & ""): Ar(2, M) = Ar(2, M) + T2: Ar(3, M) = Ar(3, M) + T3
Else
N = N + 1: xD(T & "") = N
ReDim Preserve Ar(1 To 3, 1 To N)
If Left(Arr(i, 1), 6) <> "LV0999" Then Ar(1, N) = T
Ar(2, N) = T2: Ar(3, N) = T3
End If
98: If T = "" Then
If M > 0 Then Cells(i, 4).Resize(N, 3) = Application.Transpose(Ar)
N = 0: M = 0: Set xD = Nothing: Erase Ar
Set xD = CreateObject("Scripting.Dictionary")
End If
99: Next
End Sub |
|