通過 VBA 將 Excel 表寫入 CSV

Question

我有一個帶有固定表格的 Excel 電子表格。 我想將此表導出為 CSV 文件。

我創建了一個按鈕並實現了以下代碼； 但是，該文件創建時僅包含逗號（不添加來自單元格的數據）。

Sub CommandButton21_Click()

Dim FilePath As String
Dim CellData As String

CellData = ""

FilePath = Application.DefaultFilePath & "\Table.txt"

Open FilePath For Output As #1

For i = 30 To 34

    For j = 3 To 7

        CellData = CellData + Trim(ActiveCell(i, j).Value) + ","

    Next j

    Write #1, CellData

    CellData = ""

Next i

Close #1

End Sub

Answer 1

Excel 會將整個工作表保存為 .csv 文件。 您不需要單獨保存單元格。

使用此代碼

Sub CSVfile()
    ActiveWorkbook.SaveAs Filename:="C:\Users\AlexBor\Documents\my_excel_sheet.csv",    _
    FileFormat:=xlCSV, CreateBackup:=False
End Sub

它將保存所有非空單元格，保留表格格式。 當然，您可以選擇其他文件格式 .txt 和制表符分隔符，例如。

Answer 2

Option Explicit

Sub CSV_toCSV(ByVal tablename As String)
    Dim theTable As ListObject

    Set theTable = ThisWorkbook.ActiveSheet.ListObjects(tablename)
    toCSV_header theTable, ",", """", """"""
    toCSV_data theTable, ", ", """", """"""
End Sub

Sub CSV_toDBInserts(ByVal tablename As String)
    Dim theTable As ListObject

    Set theTable = ThisWorkbook.ActiveSheet.ListObjects(tablename)
    toCSV_header theTable, ", ", "", "", "INSERT INTO " & theTable.Name & " (", ") VALUES"
    toCSV_data theTable, ", ", "'", "''", "(", "),", ");"
End Sub

Private Sub toCSV_header(ByRef table As ListObject, ByVal delimiter As String, ByVal quote As String, ByVal quoteWith As String, Optional ByVal prefix As String = "", Optional ByVal postfix As String = "")
    Dim theTable As ListObject
    Dim line As String
    Dim curVal As String
    Dim c  As Integer
    Dim first As Boolean
    first = True

    Set theTable = ThisWorkbook.ActiveSheet.ListObjects("thetable")

    line = prefix
    For c = 1 To theTable.ListColumns.Count
        If first Then
            first = False
        Else
            line = line & delimiter
        End If

        curVal = theTable.HeaderRowRange.Cells(1, c).Value
        If Not quote = "" Then
            curVal = Replace(curVal, quote, quoteWith)
        End If
        line = line & quote & curVal & quote
    Next c
    line = line & postfix

Debug.Print line
End Sub

Private Sub toCSV_data(ByRef table As ListObject, ByVal delimiter As String, ByVal quote As String, ByVal quoteWith As String, Optional ByVal prefix As String = "", Optional ByVal postfix As String = "", Optional ByVal globalPostfix As String = "")
    Dim theTable As ListObject
    Dim line As String
    Dim curVal As String
    Dim r, c, h  As Integer
    Dim first As Boolean
    first = True

    Set theTable = ThisWorkbook.ActiveSheet.ListObjects("thetable")

    'Change the path and file name accordingly
    'Open "/Users/hoffmd9/tmp" For Output As #1

    For r = 1 To theTable.DataBodyRange.Rows.Count
        line = prefix
        For c = 1 To theTable.DataBodyRange.Columns.Count
            If first Then
                first = False
            Else
                line = line & delimiter
            End If

            curVal = theTable.DataBodyRange.Cells(r, c).Value
            If Not quote = "" Then
                curVal = Replace(curVal, quote, quoteWith)
            End If
            line = line & quote & curVal & quote

        Next c
        If r = theTable.ListRows.Count Then
            line = line & globalPostfix
        Else
            line = line & postfix
        End If
        first = True
Debug.Print line
    Next r

    'Change the path and file name accordingly
    'Open "/Users/hoffmd9/tmp" For Output As #1
    'Write #1, CStr(Cells(i, j).Value);
    'Close #1

End Sub

Answer 3

Sub saveTableToCSV()

    Dim tbl As ListObject
    Dim csvFilePath As String
    Dim fNum As Integer
    Dim tblArr
    Dim rowArr
    Dim csvVal

    Set tbl = Worksheets("YourSheetName").ListObjects("YourTableName")
    csvFilePath = "C:\Users\vmishra\Desktop\CSVFile.csv"
    tblArr = tbl.DataBodyRange.Value

    fNum = FreeFile()
    Open csvFilePath For Output As #fNum
    For i = 1 To UBound(tblArr)
        rowArr = Application.Index(tblArr, i, 0)
        csvVal = VBA.Join(rowArr, ",")
        Print #1, csvVal
    Next
    Close #fNum
    Set tblArr = Nothing
    Set rowArr = Nothing
    Set csvVal = Nothing
End Sub

1. 將表格的全部內容存儲到二維數組中 - tblArr
2. 對於每一行 - 將數據提取到一維數組 rowArr 中
3. 用逗號作為分隔符將一維數組的所有數據連接起來並存入一個變量——csvVal
4. 在 csv 文件（已創建）中打印此逗號分隔數據
5. 對表的每一行重復這個過程 - For 循環用於這樣做