­ã´£³¡ªL

ÃD·N¤£²M, ´NµLªk¦^À³!!!

1. Sub TEST()
   
2. Dim T$, Arr, Brr, Crr, Bn&, Cn&, Sb, Sc, i&, j%
   
3. [G3:I6000,K3:M6000].ClearContents:  [I1,M1] = ""
   
4. If [G1] = "" Then Exit Sub
   
5. Arr = Range("B2:D" & Cells(Rows.Count, 2).End(xlUp).Row)
   
6. ReDim Brr(1 To UBound(Arr), 1 To 3): Crr = Brr
   
7. For i = 1 To UBound(Arr)
   
8.     If Arr(i, 1) <> [G1] Then GoTo 101
   
9.     If Left(Arr(i, 2), 1) Like "[0-1]" Then
   
10.        Bn = Bn + 1: Sb = Sb + Val(Arr(i, 3))
    
11.        For j = 1 To 3: Brr(Bn, j) = Arr(i, j): Next
    
12.     ElseIf Left(Arr(i, 2), 1) Like "[2-9]" Then
    
13.        Cn = Cn + 1: Sc = Sc + Val(Arr(i, 3))
    
14.        For j = 1 To 3: Crr(Cn, j) = Arr(i, j): Next
    
15.     End If
    
16. 101: Next i
    
17. If Bn > 0 Then [G3:I3].Resize(Bn) = Brr: [I1] = Sb
    
18. If Cn > 0 Then [K3:M3].Resize(Cn) = Crr: [M1] = Sc
    
19. End Sub

½Æ»s¥N½X

Xl0000193.rar (20.08 KB)

¤U¸ü¦¸¼Æ: 2

2016-10-21 16:53