| ©«¤l976 ¥DÃD7 ºëµØ0 ¿n¤À1018 ÂI¦W0  §@·~¨t²ÎWin10 ³nÅ骩¥»Office 2016 ¾\ŪÅv50 ©Ê§O¨k µù¥U®É¶¡2013-4-19 ³Ì«áµn¿ý2025-8-22 
 | 
                
| ¥»©«³Ì«á¥Ñ 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
 | 
 |