Hsieh

¦^´_ 1# luke

1. Sub nn()
   
2. With sheet2
   
3. Set Rng = .Range(.[A1], .[A1].End(xlDown))
   
4. k = 11
   
5. For Each a In sheet1.[B1:B5]
   
6. mystr = "SUMPRODUCT((left(sheet2!" & Rng.Address & ",2)=""" & a.Offset(, -1) & """)*1)"
   
7. Set c = .Columns("A:A").Find(a.Offset(, -1), after:=.[A65536], lookat:=xlPart)
   
8. r = Evaluate(mystr)
   
9. For i = 1 To a
   
10.    c.Resize(r, 10).Copy sheet1.Cells(k, 1)
    
11.    k = k + r
    
12. Next
    
13. Next
    
14. End With
    
15. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 7# luke

1. Sub ex()
   
2. Dim Ay()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. With sheet2
   
5.   For Each a In .Range(.[A1], .[A65536].End(xlUp))
   
6.      If IsEmpty(d(Left(a, 2))) Then
   
7.        Set d(Left(a, 2)) = a.Resize(, 10)
   
8.        Else
   
9.        Set d(Left(a, 2)) = Union(d(Left(a, 2)), a.Resize(, 10))
   
10.     End If
    
11. Next
    
12. End With
    
13. r = 11
    
14. With sheet1
    
15. .Range("A11").CurrentRegion.Clear
    
16.   For Each a In .[B1:B5]
    
17.   If d.exists(a.Offset(, -1).Value) = True Then
    
18.       For i = 1 To a
    
19.         d(a.Offset(, -1).Value).Copy .Cells(r, 1)
    
20.         r = .Cells(11, 1).End(xlDown).Row + 1
    
21.       Next
    
22.   End If
    
23.   Next
    
24. End With
    
25. End Sub

½Æ»s¥N½X