Hsieh

¦^´_ 7# melvinhsu1105

1. Sub ex()
   
2. Dim Ar()
   
3. With ActiveSheet
   
4. a = .Range("A1").CurrentRegion
   
5. ReDim Preserve Ar(s)
   
6. Ar(s) = Application.Index(a, 1)
   
7. s = s + 1
   
8. For i = 2 To UBound(a, 1)
   
9.    For j = 1 To a(i, 1)
   
10.       ReDim Preserve Ar(s)
    
11.       Ar(s) = Application.Index(a, i)
    
12.       s = s + 1
    
13.    Next
    
14. Next
    
15. End With
    
16. With Workbooks.Add
    
17.   .Sheets(1).[A1].Resize(s, UBound(a, 2)) = Application.Transpose(Application.Transpose(Ar))
    
18.   .Sheets(1).Columns("A").Delete
    
19.   '.SaveAs "D:\Test.xls" '·sÀɦsÀɥؿý¦Û¦æ­×§ï
    
20. End With
    
21.   
    
22. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 9# melvinhsu1105


    ¤W¶Ç§A§@ªºÀɮ׬ݬÝ