Hsieh

¦^´_ 7# luke

1. Sub Split_CSV()
   
2. Dim Ar(), Ay()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Application.DisplayAlerts = False
   
5. Application.ScreenUpdating = False
   
6. fd = ThisWorkbook.Path & "\"
   
7. fs = fd & "TEST21.csv"
   
8. Set wb = Workbooks.Open(fs)
   
9. yn = False
   
10.   With wb.Sheets(1) '¤À³ÎÀÉ®×
    
11.   k = .UsedRange.Columns.Count
    
12.      For Each a In .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
    
13.         If yn = False And InStr(a, ".csv") > 0 Then _
    
14.         yn = True: r = 1: _
    
15.          f = Replace(Replace(Replace(a, "[", ""), "]", ""), "*", ""): _
    
16.          Set sh = wb.Sheets.Add(after:=wb.Sheets(1))
    
17.          Ar = a.Resize(, k).Value
    
18.          With sh
    
19.          If yn = True Then
    
20.          .Cells(r, 1).Resize(, k) = Ar: r = r + 1
    
21.          ReDim Preserve Ay(s)
    
22.          Ay(s) = Join(Application.Transpose(Application.Transpose(Ar)), Chr(9))
    
23.          s = s + 1
    
24.          End If
    
25.          End With
    
26.         If InStr(a, "div") > 0 Then fs = fd & "µ²ªG\" & f: yn = False: sh.Move: ActiveWorkbook.SaveAs fd & "µ²ªG\" & f, 6: Workbooks(f).Close:        d(f) = Join(Ay, Chr(10)): Erase Ay: s = 0
    
27.      Next
    
28.     End With
    
29. wb.Close 0
    
30.     fs = Dir(fd & "*.csv")
    
31.     Do Until fs = ""
    
32.     If fs <> "TEST21.csv" Then
    
33.     Set wb = Workbooks.Open(fd & fs)
    
34.     With wb.Sheets(1)
    
35.     k = .UsedRange.Columns.Count
    
36.     ReDim Ar(k)
    
37.     Ar(0) = "[*" & fs & "*]"
    
38.       For i = 1 To k - 1
    
39.         Ar(i) = ""
    
40.       Next
    
41.     ReDim Preserve Ay(s)
    
42.     Ay(s) = Join(Ar, Chr(9))
    
43.     s = s + 1
    
44.     For Each a In .UsedRange.Columns(1).Cells
    
45.        Ar = a.Resize(, k).Value
    
46.     ReDim Preserve Ay(s)
    
47.     Ay(s) = Join(Application.Transpose(Application.Transpose(Ar)), Chr(9))
    
48.     s = s + 1
    
49.     Next
    
50.     ReDim Preserve Ay(s)
    
51.     Ay(s) = Join(Array("", "", "", "", "", "", "", ""), Chr(9))
    
52.     s = s + 1
    
53.     ReDim Ar(k)
    
54.     Ar(0) = "[*div*]"
    
55.       For i = 1 To k - 1
    
56.         Ar(i) = ""
    
57.       Next
    
58.     ReDim Preserve Ay(s)
    
59.     Ay(s) = Join(Ar, Chr(9))
    
60.     s = s + 1
    
61.     d(fs) = Join(Ay, Chr(10))
    
62.     Erase Ay: s = 0
    
63.     End With
    
64.     wb.Close 0
    
65.     End If
    
66.     fs = Dir
    
67.     Loop
    
68. With Worksheets.Add
    
69. .[A1].Resize(d.Count, 1) = Application.Transpose(d.keys)
    
70. .[A1].Resize(d.Count, 1).Sort key1:=.[A1], Header:=xlNo
    
71. Ar = .[A1].Resize(d.Count, 1).Value
    
72. r = 1
    
73. For Each ky In Ar '²Õ¦XÀÉ®×
    
74.    an = Split(d(ky), Chr(10))
    
75.    For j = 0 To UBound(an)
    
76.      ak = Split(an(j), Chr(9))
    
77.      .Cells(r, 1).Resize(, UBound(ak) + 1) = ak
    
78.      r = r + 1
    
79.    Next
    
80.    r = r + 1
    
81. Next
    
82. .Move
    
83. ActiveWorkbook.SaveAs fd & "µ²ªG\" & "TEST21OK.csv", 6
    
84. ActiveWorkbook.Close 1
    
85. End With
    
86. Application.DisplayAlerts = True
    
87. Application.ScreenUpdating = True
    
88. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 12# luke

§Ú´ú¸ÕOKªü

¤U¸ü (649.92 KB)

2012-6-6 21:22