如何用VBA匯入CSV檔?

am0251

有高手可以教我一下如何用VBA匯入CSV檔呢?還可以自選列和分隔的符號,謝謝~~!

jimmyhk

回復 1# am0251

是這個嗎?

1. sub openCSV()
   
2. 
   
3. dim mydir as string
   
4. mydir = thisworkbook.path & "\"
   
5. workbooks.opentext filename:=mydir & 123.txt, datatype:=xldelimited, comma:=true
   
6. 
   
7. end sub

複製代碼

am0251

謝謝回復,開啟是沒問題,可是我只想匯入我想要的行數,又該怎麼寫呢?

GBKEE

回復 3# am0251
可是我只想匯入我想要的行數  這樣的問法,很空洞的 難怪沒人回答
要附上文字檔: 說明要搜尋的特定的字串? 如何 匯入? 何時停止匯入?

luhpro

有高手可以教我一下如何用VBA匯入CSV檔呢?還可以自選列和分隔的符號,謝謝~~!
am0251 發表於 2011-9-3 17:09

是底下這樣嗎?

1. Sub nn()
   
2.   Call openCSV("123.txt", 3, 6, " ")
   
3. End Sub

複製代碼

1. Sub openCSV(ByVal sFileName$, lStartLine As Long, lLoadLine As Long, sChar$)
   
2.   ' sFileName : CSV檔案名稱, lStartLine : 開始列號, lLoadLine : 讀取列數, sChar : 分隔字元
   
3.   Dim iI%
   
4.   Dim sFullName$, sStr$
   
5.   Dim lJ As Long, lPos As Long
   
6.   Dim vData
   
7.   
   
8.   sFullName = ThisWorkbook.Path & "\" & sFileName
   
9. 
   
10.   If Dir(sFullName) <> "" Then
    
11.     Open sFullName For Input Access Read Shared As #1
    
12.       lJ = 1
    
13.       Do While lJ < lStartLine
    
14.         Line Input #1, sStr
    
15.         lJ = lJ + 1
    
16.       Loop
    
17.       
    
18.       For lJ = 1 To lLoadLine
    
19.         Line Input #1, sStr
    
20.         ReDim vData(0)
    
21.         vData = Split(sStr, sChar)
    
22. ' 題外話 : Cells(lJ, 1).Resize(, UBound(vData) + 1) = Application.Transpose(vData) 此行結果不正確不知錯在哪裡, 只好改成以下這樣的迴圈...
    
23.          For iI = 0 To UBound(vData)
    
24.            Cells(lJ, iI + 1) = vData(iI)
    
25.          Next iI
    
26.       Next lJ
    
27.     Close (1)
    
28.   Else
    
29.     MsgBox ("找不到 " & sFileName & " 檔案")
    
30.   End If
    
31. End Sub

複製代碼

am0251

270710.rar (18.22 KB)

下載次數: 14

2011-9-28 15:02

謝謝兩位的回覆,只是luhpro大大的寫法有點難,小的沒看懂多少,其實我只是想"匯入"CSV"檔,而不是"開啟"因為我要選擇"分隔符號",如"TAB鍵" "分號" "逗點" "空格" 等方法,還有就是匯入的行數,如這個檔案,我的分隔符號是 "逗點" 和 "空格",匯入的行數只是第2行和第5行,該怎麼寫呢?

GBKEE

回復 6# am0251

1. Sub Ex()
   
2.     Dim 匯出檔 As String, 匯入檔 As Workbook
   
3.     Set 匯入檔 = ActiveWorkbook     'Set 匯入檔 = Workbooks("TEST.XLS")
   
4.     匯出檔 = "D:\TEST\270710.CSV"
   
5.     With Workbooks.Open(匯出檔).Sheets(1)
   
6.         .Range("A5").Resize(5).EntireRow.Copy 匯入檔.Sheets(1).[A1]
   
7.         '.Range("A5").Resize(5) ->5列  ,  EntireRow 整列範圍
   
8.           .Parent.Close False    '關閉 匯出檔
   
9.     End With
   
10. End Sub

複製代碼

am0251

謝謝回覆,可能是我表達的不是很好,這個檔案是我用"資料 - 從文字檔"的方法匯入的,"SHEET1"分隔符號是用了,"逗點" 和 "空格","SHEET2"就是我要的目的了,只有第2和第5行匯入了,我只是沒辦法寫出來........ Inport CSV.rar (122.98 KB)

下載次數: 10

2011-9-29 13:19

GBKEE

回復 8# am0251

1. Sub Ex()
   
2.     Dim 匯出檔 As String, 匯入檔 As Workbook
   
3.     Set 匯入檔 = ActiveWorkbook
   
4.     'Set 匯入檔 = Workbooks("TEST.XLS")
   
5.     匯出檔 = "D:\TEST\270710.CSV"
   
6.     With Workbooks.Open(匯出檔).Sheets(1)
   
7.         匯入檔.Sheets(1).Range("A:A") = .Range("B:B").Value
   
8.         匯入檔.Sheets(1).Range("B:B") = .Range("E:E").Value
   
9.         .Parent.Close False    '關閉 匯出檔
   
10.     End With
    
11. End Sub

複製代碼

am0251

謝謝回覆,可是我用"錄製"的方法得到了下面的巨集,有沒有辦法簡單的方法寫出來呢?

1. Sub csv()
   
2. '
   
3. ' csv Macro
   
4. '
   
5. 
   
6. '
   
7.     With ActiveSheet.QueryTables.ADD(Connection:= _
   
8.         "TEXT;E:\Excel\270710.csv", Destination:=Range("$A$1"))
   
9.         .Name = "270710"
   
10.         .FieldNames = True
    
11.         .RowNumbers = False
    
12.         .FillAdjacentFormulas = False
    
13.         .PreserveFormatting = True
    
14.         .RefreshOnFileOpen = False
    
15.         .RefreshStyle = xlInsertDeleteCells
    
16.         .SavePassword = False
    
17.         .SaveData = True
    
18.         .AdjustColumnWidth = True
    
19.         .RefreshPeriod = 0
    
20.         .TextFilePromptOnRefresh = False
    
21.         .TextFilePlatform = 950
    
22.         .TextFileStartRow = 1
    
23.         .TextFileParseType = xlDelimited
    
24.         .TextFileTextQualifier = xlTextQualifierDoubleQuote
    
25.         .TextFileConsecutiveDelimiter = True
    
26.         .TextFileTabDelimiter = True
    
27.         .TextFileSemicolonDelimiter = False
    
28.         .TextFileCommaDelimiter = True
    
29.         .TextFileSpaceDelimiter = True
    
30.         .TextFileColumnDataTypes = Array(1, 1, 9, 9, 1, 1, 1)
    
31.         .TextFileTrailingMinusNumbers = True
    
32.         .Refresh BackgroundQuery:=False
    
33.     End With
    
34. End Sub

複製代碼