Excel：将工作sheet 导出为 CSV 文件的宏，而不离开我当前的 Excel sheet

Question

这里有很多关于创建宏以将工作表保存为 CSV 文件的问题。所有答案都使用另存为，例如 SuperUser 的 this one。他们基本上说要像这样创建一个 VBA 函数：

Sub SaveAsCSV()
    ActiveWorkbook.SaveAs FileFormat:=clCSV, CreateBackup:=False
End Sub

这是一个很好的答案，但我想做一个 导出而不是另存为 。当执行 SaveAs 时，它给我带来了两个烦恼：

我当前的工作文件变成了 CSV 文件。我想继续使用我原来的 .xlsm 文件，但要将当前工作表的内容导出到同名的 CSV 文件。
出现一个对话框，要求我确认是否要重写 CSV 文件。

是否可以只将当前工作表导出为文件，但继续在我的原始文件中工作？

Answer 1

@NathanClement 快了一点。然而，这里是完整的代码（稍微详细一点）：

Option Explicit

Public Sub ExportWorksheetAndSaveAsCSV()

Dim wbkExport As Workbook
Dim shtToExport As Worksheet

Set shtToExport = ThisWorkbook.Worksheets("Sheet1")     'Sheet to export as CSV
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False                       'Possibly overwrite without asking
wbkExport.SaveAs Filename:="C:\tmp\test.csv", FileFormat:=xlCSV
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False

End Sub

Answer 2

几乎是我想要的@Ralph，但这是最佳答案，因为它解决了一些问题：

它导出当前 sheet，而不仅仅是名为“Sheet1”的硬编码 sheet；
它导出到一个名为当前 sheet
它尊重语言环境分隔字符。
您继续编辑 xlsx 文件，而不是编辑导出的 CSV。

为了解决这些问题，并满足我的所有要求，我对code from here进行了适配。我对其进行了一些清理以使其更具可读性。

Option Explicit
Sub ExportAsCSV()
 
    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook
     
    Set CurrentWB = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy
 
    Set TempWB = Application.Workbooks.Add(1)
    With TempWB.Sheets(1).Range("A1")
      .PasteSpecial xlPasteValues
      .PasteSpecial xlPasteFormats
    End With        

    Dim Change below to "- 4"  to become compatible with .xls files
    MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"
     
    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub

上面的代码还有一些小问题需要注意：

.Close 和 DisplayAlerts=True 应该在 finally 子句中，但我不知道如何在 VBA
只要当前文件名有4个字母，比如.xlsm，它就可以工作。不适用于 .xls excel 旧文件。对于3个字符的文件扩展名，您必须在上面代码中设置MyFileName时将- 5更改为- 4。
作为附带效果，您的剪贴板将替换为当前 sheet 内容。

编辑：将 Local:=True 与我的区域设置 CSV 定界符一起保存。

Answer 3

正如我评论的那样，此站点上有几个地方将工作表的内容写入 CSV。 This one and this one 仅指出两个。

以下是我的版本

它明确地寻找单元格内的“,”
它也使用UsedRange——因为你想得到工作表中的所有内容
使用数组进行循环，因为这比遍历工作表单元格更快
我没有使用 FSO 例程，但这是一个选项

代码...

Sub makeCSV(theSheet As Worksheet)
Dim iFile As Long, myPath As String
Dim myArr() As Variant, outStr As String
Dim iLoop As Long, jLoop As Long

myPath = Application.ActiveWorkbook.Path
iFile = FreeFile
Open myPath & "\myCSV.csv" For Output Lock Write As #iFile

myArr = theSheet.UsedRange
For iLoop = LBound(myArr, 1) To UBound(myArr, 1)
    outStr = ""
    For jLoop = LBound(myArr, 2) To UBound(myArr, 2) - 1
        If InStr(1, myArr(iLoop, jLoop), ",") Then
            outStr = outStr & """" & myArr(iLoop, jLoop) & """" & ","
        Else
            outStr = outStr & myArr(iLoop, jLoop) & ","
        End If
    Next jLoop
    If InStr(1, myArr(iLoop, jLoop), ",") Then
        outStr = outStr & """" & myArr(iLoop, UBound(myArr, 2)) & """"
    Else
        outStr = outStr & myArr(iLoop, UBound(myArr, 2))
    End If
    Print #iFile, outStr
Next iLoop

Close iFile
Erase myArr

End Sub

Answer 4

根据我对@neves post 的评论，我通过添加 xlPasteFormats 和值部分稍微改进了这一点，这样日期就可以作为日期跨过 - 我主要将银行对帐单保存为 CSV，因此需要日期.

Sub ExportAsCSV()

    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook

    Set CurrentWB = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy

    Set TempWB = Application.Workbooks.Add(1)
    With TempWB.Sheets(1).Range("A1")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With

    'Dim Change below to "- 4"  to become compatible with .xls files
    MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"

    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub

Answer 5

对于需要对输出进行更多自定义（分隔符或小数符号）或具有大型数据集（超过 65k 行）的情况，我编写了以下内容：

Option Explicit

Sub rng2csv(rng As Range, fileName As String, Optional sep As String = ";", Optional decimalSign As String)
'export range data to a CSV file, allowing to chose the separator and decimal symbol
'can export using rng number formatting!
'by Patrick Honorez --- www.idevlop.com
    Dim f As Integer, i As Long, c As Long, r
    Dim ar, rowAr, sOut As String
    Dim replaceDecimal As Boolean, oldDec As String

    Dim a As Application:   Set a = Application

    ar = rng
    f = FreeFile()
    Open fileName For Output As #f

    oldDec = Format(0, ".")     'current client's decimal symbol
    replaceDecimal = (decimalSign <> "") And (decimalSign <> oldDec)

    For Each r In rng.Rows
        rowAr = a.Transpose(a.Transpose(r.Value))
        If replaceDecimal Then
            For c = 1 To UBound(rowAr)
                'use isnumber() to avoid cells with numbers formatted as strings
                If a.IsNumber(rowAr(c)) Then
                    'uncomment the next 3 lines to export numbers using source number formatting
'                    If r.cells(1, c).NumberFormat <> "General" Then
'                        rowAr(c) = Format$(rowAr(c), r.cells(1, c).NumberFormat)
'                    End If
                    rowAr(c) = Replace(rowAr(c), oldDec, decimalSign, 1, 1)
                End If
            Next c
        End If
        sOut = Join(rowAr, sep)
        Print #f, sOut
    Next r
    Close #f

End Sub

Sub export()
    Debug.Print Now, "Start export"
    rng2csv shOutput.Range("a1").CurrentRegion, RemoveExt(ThisWorkbook.FullName) & ".csv", ";", "."
    Debug.Print Now, "Export done"
End Sub

Answer 6

这里对上面的答案稍作改进，在同一例程中同时处理 .xlsx 和 .xls 文件，以防对某人有所帮助！

我还加了一行选择用活动的sheet名字保存而不是工作簿，这对我经常最实用：

Sub ExportAsCSV()

    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook

    Set CurrentWB = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy

    Set TempWB = Application.Workbooks.Add(1)
    With TempWB.Sheets(1).Range("A1")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With

    MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, InStrRev(CurrentWB.Name, ".") - 1) & ".csv"
    'Optionally, comment previous line and uncomment next one to save as the current sheet name
    'MyFileName = CurrentWB.Path & "\" & CurrentWB.ActiveSheet.Name & ".csv"


    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub

Answer 7

您可以使用不带参数的 Worksheet.Copy 将工作表复制到新工作簿。 Worksheet.Move 会将工作表复制到新工作簿并将其从原始工作簿中删除（您可能会说“导出”它）。
获取对新创建的工作簿的引用并另存为 CSV。
将 DisplayAlerts 设置为 false 以禁止显示警告消息。（完成后别忘了将其重新打开）。
您需要在保存和关闭工作簿时关闭 DisplayAlerts。

    wsToExport.Move

    With Workbooks
        Set wbCsv = .Item(.Count)
    End With

    Application.DisplayAlerts = False
    wbCsv.SaveAs xlCSV
    wbCsv.Close False
    Application.DisplayAlerts = True

Excel：将工作sheet 导出为 CSV 文件的宏，而不离开我当前的 Excel sheet

Excel: macro to export worksheet as CSV file without leaving my current Excel sheet

csv

excel

vba

export-to-csv