Hsieh

¦^´_ 3# PD961A

1. Sub nn()
   
2. With Sheets("½s¸¹")
   
3. ReDim ar(.[H2] - 1)
   
4. cnt = CDec(Mid(.[D2], 2))
   
5. For i = 0 To .[H2] - 1
   
6.   ar(i) = Array(.[A2].Value, "'" & .[B2].Value, .[C2].Value, Mid(.[D2], 1, 1) & cnt + i, .[E2].Value, .[F2].Value, .[G2].Value)
   
7. Next
   
8. Sheet1.[A2].Resize(.[H2], 7) = Application.Transpose(Application.Transpose(ar))
   
9. End With
   
10. End Sub

½Æ»s¥N½X

Hsieh

1. Sub nn()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. Set d1 = CreateObject("Scripting.Dictionary")
   
4. With Sheets("½s¸¹")
   
5. For Each a In .Range(.[A2], .[A65536].End(xlUp))
   
6.     d(a.Value) = d(a.Value) + a.Offset(, 7)
   
7.     d1(a.Value) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, Mid(a.Offset(, 3), 1, 11), a.Offset(, 4).Value, a.Offset(, 5).Value, a.Offset(, 6).Value)
   
8. Next
   
9. Sheets("Sheet1").[A2:G65536].Clear
   
10. For Each ky In d.keys
    
11.    ReDim Ar(d(ky))
    
12.    For i = 0 To d(ky) - 1
    
13.      x = d1(ky)(3) & Format(i, "0000000")
    
14.      With Sheets("Sheet1")
    
15.        .[A65536].End(xlUp).Offset(1, 0).Resize(, 7) = Array(d1(ky)(0), d1(ky)(1), d1(ky)(2), x, d1(ky)(4), d1(ky)(5), d1(ky)(6))
    
16.      End With
    
17.    Next
    
18. Next
    
19. End With
    
20. End Sub

½Æ»s¥N½X