oobird

°ÝÃD3

1. Sub yy()
   
2.     Dim d As Object, a, b, i&, j%, k%, m%, n%
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     k = 1
   
5.     With Sheets("ASD1")
   
6.         a = .Range(.[a2], .[c65536].End(3))
   
7.         ReDim b(1 To UBound(a), 1 To 3)
   
8.         For i = 1 To UBound(a)
   
9.             If Len(a(i, 2)) = 6 Then
   
10.                 m = m + 1
    
11.                 For j = 1 To 3
    
12.                     b(m, j) = a(i, j)
    
13.                 Next
    
14.             End If
    
15.         Next
    
16.         Do
    
17.             For i = 1 To m
    
18.                 If b(i, 2) <> "" Then
    
19.                     If Not d.exists(b(i, 1)) Then
    
20.                         d(b(i, 1)) = Array(b(i, 1) & "", b(i, 2), b(i, 3))
    
21.                         b(i, 2) = "": n = n + 1
    
22.                     End If
    
23.                 End If
    
24.             Next
    
25.             If d.Count > 0 Then
    
26.                 Sheets("BF12").Cells(1, k).Resize(, 3) = .[a1:c1].Value
    
27.                 Sheets("BF12").Cells(2, k).Resize(d.Count, 3) = Application.Transpose(Application.Transpose(d.items))
    
28.                 d.RemoveAll
    
29.                 k = k + 3
    
30.             End If
    
31.         Loop Until n = m
    
32.     End With
    
33. End Sub

½Æ»s¥N½X