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

Question

提问by neves

There are a lot of questions here to create a macro to save a worksheet as a CSV file. All the answers use the SaveAs, like this onefrom SuperUser. They basically say to create a VBA function like this:

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

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

This is a great answer, but I want to do an export instead of Save As. When the SaveAs is executed it causes me two annoyances:

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

My current working file becomes a CSV file. I'd like to continue working in my original .xlsm file, but to export the contents of the current worksheet to a CSV file with the same name.
A dialog appears asking me confirm that I'd like to rewrite the CSV file.

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

Is it possible to just export the current worksheet as a file, but to continue working in my original file?

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

Answer 1

采纳答案by neves

Almost what I wanted @Ralph. Your code has some problems:

几乎是我想要的@Ralph。您的代码有一些问题：

it exports just the hardcoded sheet named "Sheet1";
it always export to the same temp file, overwriting it;
it ignores the locale separation char.

它仅导出名为“Sheet1”的硬编码表；
它总是导出到同一个临时文件，覆盖它；
它忽略区域设置分隔字符。

To solve these problems, and meet all my requirements, I've adapted the code from here. I've cleaned it a little to make it more readable.

为了解决这些问题并满足我的所有要求，我修改了此处的代码。我已经对其进行了一些清理以使其更具可读性。

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

There are still some small thing with the code above that you should notice:

上面的代码还有一些你应该注意的小东西：

.Closeand DisplayAlerts=Trueshould be in a finally clause, but I don't know how to do it in VBA
It works just if the current filename has 4 letters, like .xlsm. Wouldn't work in .xls excel files. For file extensions of 3 chars, you must change the - 5to - 4when setting MyFileName.
As a collateral effect, your clipboard will be substituted with current sheet contents.

.Close并且DisplayAlerts=True应该在 finally 子句中，但我不知道如何在 VBA 中做到这一点
仅当当前文件名有 4 个字母时才有效，例如 .xlsm。不适用于 .xls excel 文件。对于3个字符的文件扩展名，则必须更改- 5到- 4设置MyFileName的时候。
作为附带效果，您的剪贴板将替换为当前工作表内容。

Edit: put Local:=Trueto save with my locale CSV delimiter.

编辑：Local:=True使用我的语言环境 CSV 分隔符保存。

Answer 2

回答by Ralph

@NathanClement was a bit faster. Yet, here is the complete code (slightly more elaborate):

@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 3

回答by Craig Lambie

As per my comment on @neves post, I slightly improved this by adding the xlPasteFormats as well as values part so dates go across as dates - I mostly save as CSV for bank statements, so needed dates.

根据我对@neves 帖子的评论，我通过添加 xlPasteFormats 和 values 部分稍微改进了这一点，以便日期作为日期 - 我主要保存为 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 4

回答by Patrick Honorez

For those situations where you need a bit more customisation of the output (separator or decimal symbol), or who have large dataset (over 65k rows), I wrote the following:

对于需要对输出进行更多自定义（分隔符或十进制符号）或具有大型数据集（超过 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 5

回答by nobilis

Here is a slight improvement on the this answer above taking care of both .xlsx and .xls files in the same routine, in case it helps someone!

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

I also add a line to choose to save with the active sheet name instead of the workbook, which is most practical for me often:

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

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 6

回答by OldUgly

As I commented, there are a few places on this site that write the contents of a worksheet out to a CSV. This oneand this oneto point out just two.

正如我评论的那样，这个站点上有几个地方可以将工作表的内容写入 CSV。这一和这一点只指出两个。

Below is my version

下面是我的版本

it explicitly looks out for "," inside a cell
It also uses UsedRange- because you want to get all of the contents in the worksheet
Uses an array for looping as this is faster than looping through worksheet cells
I did not use FSO routines, but this is an option

它明确地寻找单元格内的“，”
它还使用UsedRange- 因为您想获取工作表中的所有内容
使用数组进行循环，因为这比循环工作表单元格快
我没有使用 FSO 例程，但这是一个选项

The code ...

编码 ...

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

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

提问by neves

采纳答案by neves

回答by Ralph

回答by Craig Lambie

回答by Patrick Honorez

回答by nobilis

回答by OldUgly

相关推荐

最近更新

标签

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

提问by neves

采纳答案by neves

回答by Ralph

回答by Craig Lambie

回答by Patrick Honorez

回答by nobilis

回答by OldUgly

相关推荐

在 vba 函数中解决最大字符串大小？

当 VBA 中的自动过滤器不返回数据时该怎么办？

使用 Excel-VBA 获取 HTML 源代码

vba 宏分配的按钮在 Excel 中不起作用

相关推荐

最近更新

标签