Hsieh

回復 2# donod

1. Sub input_txt()
   
2. Dim Ay()
   
3. fs = ThisWorkbook.Path & "\test5.txt" 'TXT檔名目錄
   
4. ar = Array(";", ":", ":")
   
5. Open fs For Input As #1
   
6. Do While Not EOF(1)
   
7.    Line Input #1, mystr
   
8.    For i = 0 To 2
   
9.    Replace
   
10.       mystr = Application.Substitute(mystr, "/", ar(i), 3) '取代分隔符號
    
11.    Next
    
12.    ReDim Preserve Ay(s)
    
13.    Ay(s) = mystr
    
14.    s = s + 1
    
15. Loop
    
16. Close #1
    
17. fs = ThisWorkbook.Path & "\test5.xlsx" '寫入目標檔案目錄
    
18. With Workbooks.Open(fs)
    
19. .Sheets(1).[A1].CurrentRegion.Clear '清除原資料
    
20. .Sheets(1).[A1].Resize(s, 1) = Application.Transpose(Ay) '寫入資料
    
21. With .Sheets(1).Columns("A:A") '資料剖析
    
22.    .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    
23.    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    
24.    Semicolon:=True
    
25.    .NumberFormatLocal = "m/d/yyyy" '變更日期格式
    
26. End With
    
27. End With
    
28. End Sub

複製代碼

Hsieh

回復 4# donod
資料剖析指名引數不能忽略

1. Sub input_txt()
   
2. Dim Ay()
   
3. fs = ThisWorkbook.Path & "\test5.txt" 'TXT檔名目錄
   
4. ar = Array(";", ":", ":")
   
5. Open fs For Input As #1
   
6. Do While Not EOF(1)
   
7.    Line Input #1, mystr
   
8.    For i = 0 To 2
   
9.       mystr = Application.Substitute(mystr, "/", ar(i), 3) '取代分隔符號
   
10.    Next
    
11.    ReDim Preserve Ay(s)
    
12.    Ay(s) = mystr
    
13.    s = s + 1
    
14. Loop
    
15. Close #1
    
16. fs = ThisWorkbook.Path & "\test5.xlsx" '寫入目標檔案目錄
    
17. With Workbooks.Open(fs)
    
18. With .Sheets(1)
    
19. .[A1].CurrentRegion.Clear '清除原資料
    
20. .[A1].Resize(s, 1) = Application.Transpose(Ay) '寫入資料
    
21. '資料剖析
    
22.     .Columns("A:A").TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
    
23.         TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    
24.         Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
    
25.         :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
    
26.         Array(7, 1)), TrailingMinusNumbers:=True
    
27.    .[A:A].NumberFormatLocal = "m/d/yyyy" '變更日期格式
    
28. End With
    
29. End With
    
30. End Sub

複製代碼

Hsieh

回復 6# donod

你錄製一個A欄以分號為分隔符號的巨集看看便知

Hsieh

回復 8# donod

下載 (387.51 KB)

2013-4-8 18:24

Hsieh

回復 10# donod

錯在哪裡?
1.你這個檔如果是已經存檔
ThisWorkbook.Path已經會傳回你這個檔案的資料夾位置
fs = ThisWorkbook.Path & "D:\test5.xlsx"
這樣fs就已經不是"D:\test5.xlsx"了
Workbooks.Open就會產生找不到檔案的錯誤
2.你把程式碼寫在工作表模組內，而With Sheets(1)敘述區段內
沒有加上.(句號)就會指向程式所在工作表內的儲存格
        .Columns("A:A").TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1)), TrailingMinusNumbers:=True
只差在紅色的點Destination:=.Range("A1")