­ã´£³¡ªL

¦h±ø¥ó²Î­p, ¥i¥Î ¦r¨åÀÉ+°}¦C,
¤£¹L­þ´X­Ó±ø¥ó­n»¡²M·¡,
yn2 ¦pªG¦³y ¤Î n, ¬O§_µø¬°¤£¦P±ø¥ó?

index ¨ºÄæ°µ¤°»ò¥Î?

­ã´£³¡ªL

1. Sub TEST()
   
2. Dim R&, N&, Arr, Brr, xD, T$, i&
   
3. Sheets("Sheet2").UsedRange.Offset(1, 0).EntireRow.Delete
   
4. Arr = Sheets("Sheet1").UsedRange
   
5. ReDim Brr(1 To UBound(Arr), 1 To 8)
   
6. Set xD = CreateObject("Scripting.Dictionary")
   
7. For i = 3 To UBound(Arr)
   
8.     If Arr(i, 4) = "" Or Arr(i, 7) = "" Or Arr(i, 8) = "" Or Arr(i, 10) = "" Then GoTo 101
   
9.     T = Arr(i, 7) & "<" & Arr(i, 10) & ">" & Arr(i, 8) & "|" & Arr(i, 4)
   
10.     R = xD(T)
    
11.     If R = 0 Then
    
12.        N = N + 1: R = N: xD(T) = N
    
13.        Brr(R, 1) = Arr(i, 7)
    
14.        Brr(R, 2) = Arr(i, 8)
    
15.        Brr(R, 3) = Arr(i, 10)
    
16.        Brr(R, 7) = Arr(i, 4)
    
17.        Brr(R, 8) = Split(T, "|")(0)
    
18.     End If
    
19.     If Val(Arr(i, 14)) <> 0 Then Brr(R, 4) = Brr(R, 4) + Arr(i, 14)
    
20.     If Val(Arr(i, 21)) <> 0 Then Brr(R, 5) = Brr(R, 5) + Arr(i, 21)
    
21.     If Val(Arr(i, 22)) <> 0 Then Brr(R, 6) = Brr(R, 6) + Arr(i, 22)
    
22. 101: Next i
    
23. If N > 0 Then [Sheet2!A2].Resize(N, 8) = Brr
    
24. End Sub

½Æ»s¥N½X