Excel：将工作表导出为 CSV 文件的宏，无需离开我当前的 Excel 工作表

Posted

技术标签:

【中文标题】Excel：将工作表导出为 CSV 文件的宏，无需离开我当前的 Excel 工作表【英文标题】：Excel: macro to export worksheet as CSV file without leaving my current Excel sheet 【发布时间】：2016-08-30 11:51:11 【问题描述】：

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

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

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

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

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

【问题讨论】：

我认为您需要创建一个工作簿，将工作表复制过来，另存为 csv 并关闭工作簿。 @gtwebb：你能帮帮我吗？我的vba知识真的很初级。 在这个问题中使用“SeanC”的第二个答案：***.com/questions/26178913/… 不要使用工作簿功能。 Create and write a text file 根据 Tony Dallimore 的回答。 试试这个exceldevelopmentplatform.blogspot.com/2019/08/… 【参考方案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

【讨论】：

如果我需要UTF8格式的CSV，为什么有些excel版本不支持呢？ Ot 似乎很奇怪，是个大问题【参考方案2】：

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

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

为了解决这些问题，并满足我的所有要求，我改编了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。 作为附带效果，您的剪贴板将替换为当前工作表内容。

编辑：将Local:=True 与我的语言环境 CSV 分隔符一起保存。

【讨论】：

1. TempWB.Close False 应该是 TempWB.Close SaveChanges:=False, docs 3. 更改 Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) 中的 5 将使其与 .xls 一起使用 docs 也许我们应该使用正则表达式来删除文件扩展名，但对于一个一次性脚本 @KuN：TempWB.close 的变化是什么？ 我认为这是一个“翻译中丢失”的问题，如果您查看我提供的文档链接或@Raplh 的回答，您会发现这是调用Workbook.Close 的正确方法 这太好了，我刚刚添加了一个小东西，pastespecial xlPasteFormats 所以我的日期保持为日期：D With TempWB.Sheets(1).Range("A1") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats End With 伟大的提示@CraigLambie，刚刚将其添加到原始代码中【参考方案3】：

根据我对@neves 帖子的评论，我通过添加 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

【讨论】：

是否愿意将此作为插件，有人有时间实现吗？ 我必须为 mac 做这个，但我没有一个要测试。它会起作用吗？它与操作系统无关吗？ 对不起@horaciux 我也没有mac。从内存来看，旧版本的 excel for mac 上可用的编码非常有限......这可能已经改变，不确定。【参考方案4】：

这是对上面这个答案的轻微改进，在同一个例程中处理 .xlsx 和 .xls 文件，以防它帮助某人！

我还添加了一行以选择使用活动工作表名称而不是工作簿进行保存，这对我来说经常是最实用的：

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

【讨论】：

【参考方案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

【讨论】：

谢谢，帕特里克。你能解释一下 a.Transpose(a.Transpose(r.Value)) 实现了什么吗？ @Dodecapone '双重转置'用于将二维数组转换为一维数组。 Join 必须有一个一维数组才能工作。【参考方案6】：
    您可以使用不带参数的 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

【讨论】：

【参考方案7】：

正如我评论的那样，该网站上有几个地方可以将工作表的内容写入 CSV。 This one 和 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

【讨论】：

以上是关于Excel：将工作表导出为 CSV 文件的宏，无需离开我当前的 Excel 工作表的主要内容，如果未能解决你的问题，请参考以下文章

有没有办法将 excel 工作簿中的单个工作表导出到使用 pandas 分隔 csv 文件？

python 此要点将从Excel工作簿中提取每个单独的工作表并将其导出为CSV。

在 Pandas 中连接 Excel 文件表，以 CSV 格式每 1 行将大型 Pandas 数据框导出到新的 Excel 文件。自动化？

如何将csv导入mysql和mysql导出csv

将工作表导出为 CSV 会覆盖原始文件名 VBA

python 此快速功能将excel文件中的所有工作簿导出为单独的csv，以使数据更易于使用。