☰

使用巨集將 Office Excel 表格匯出為 csv

tag-icon • tag-icon microsoft-excel-2010 csv
使用巨集將 Office Excel 表格匯出為 csv

我在 Excel 2010 中使用 Excel 表格。

我目前的工作流程： 1. 手動選擇表格 2. 將內容複製到新工作簿 3. 將工作簿另存為 *.csv 文件

所需的工作流程： 1. 手動選擇表 2. 執行寫入預先定義檔案名稱的巨集

由於表具有唯一的名稱（例如 CurrentDataTable），是否有一個函數可以取得表格名稱、目標檔案和所需的輸出格式並寫入輸出檔案？

答案1

沒有內建的 Excel 指令或函數可以執行您想要的操作，但您可以使用 VBA 對其進行程式設計。

以下程式碼可能與您正在尋找的程式碼很接近：

Sub ExportTable()

    Dim wb As Workbook, wbNew As Workbook
    Dim ws As Worksheet, wsNew As Worksheet
    Dim wbNewName As String


   Set wb = ThisWorkbook
   Set ws = ActiveSheet

   Set wbNew = Workbooks.Add

   With wbNew
       Set wsNew = wbNew.Sheets("Sheet1")
       wbNewName = ws.ListObjects(1).Name
       ws.ListObjects(1).Range.Copy
       wsNew.Range("A1").PasteSpecial Paste:=xlPasteAll
       .SaveAs Filename:=wb.Path & "\" & wbNewName & ".csv", _
             FileFormat:=xlCSVMSDOS, CreateBackup:=False
   End With

End Sub

該代碼假設每個工作表中有一個表。它會建立一個新工作簿，將表複製到該工作簿的工作表 1 中，並將工作簿儲存為與表同名的 CSV 檔案。

答案2

這是我對 Excel 2013 的 chuff 答案版本。

Sub ExportCSV()

   Dim wb As Workbook, wbNew As Workbook
   Dim ws As Worksheet, wsNew As Worksheet

   Set wb = ThisWorkbook
   Set ws = ActiveSheet

   Set wbNew = Workbooks.Add
   Application.DisplayAlerts = False
   With wbNew
       Set wsNew = wbNew.Sheets("Sheet1")
       ws.Rows.Copy
       wsNew.Paste
       .SaveAs Filename:=ws.name & ".csv", FileFormat:=xlCSV, CreateBackup:=True
       wsNew.Delete
   End With
   Windows(ws.name & ".csv").Activate
   ActiveWindow.Close
   Application.DisplayAlerts = True

End Sub

答案3

我需要執行相同的操作，但需要指定哪些表必須匯出為 CSV 檔案。我建立了一個名為「ExportTables」的範圍，VBA 如下：

Public Sub Export()
    Dim i       As Integer
    Dim iMax    As Integer
    Dim sTable  As String

    iMax = Range("ExportTables").Rows.Count

    For i = 1 To iMax
        sTable = Range("ExportTables").Cells(i, 1).Value
        Call ExportTable(sTable)
    Next i
End Sub

Public Sub ExportTable(tableName As String)
    Dim wkb         As Workbook
    Dim wkbNew      As Workbook
    Dim wks         As Worksheet
    Dim wksNew      As Worksheet

    Set wkb = ThisWorkbook

    Application.Goto Reference:=tableName
    Set wks = ActiveSheet

    Set wkbNew = Workbooks.Add
    Set wksNew = wkbNew.Sheets(1)

    wks.ListObjects(tableName).Range.Copy
    wksNew.Range("A1").PasteSpecial Paste:=xlPasteValues

    Application.DisplayAlerts = False

    wkbNew.SaveAs Filename:=wkb.Path & "\" & tableName & ".csv", _
        FileFormat:=xlCSV, CreateBackup:=False
    wkbNew.Close SaveChanges:=False

    Application.DisplayAlerts = True

    ' Release object variables.
    Set wkb = Nothing
    Set wkbNew = Nothing
    Set wks = Nothing
    Set wksNew = Nothing
End Sub

答案4

我從上面的程式碼中收到 1004 錯誤。我將它與這個例子並得到了這個，這對我有用：

Sub ExportCSV2()

   Dim wb As Workbook, wbNew As Workbook
   Dim ws As Worksheet, wsNew As Worksheet

   Set wb = ThisWorkbook
   Set ws = ActiveSheet

   Application.DisplayAlerts = False

   ws.Copy
   ActiveWorkbook.SaveAs Filename:=ws.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=True
   Windows(ws.Name & ".csv").Activate
   ActiveWorkbook.Close False
   Application.DisplayAlerts = True

End Sub

請注意，這種（托爾斯滕）方法會匯出整個工作表，而不僅僅是表格，因此您會得到很多空白行。

相關內容