Excel:宏导出工作表作为CSV文件,而不离开我当前的Excel工作表

8wigbo56  于 2023-10-13  发布在  其他
关注(0)|答案(7)|浏览(127)

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

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

这是一个很好的答案,但我想执行导出,而不是保存为。当执行SaveAs时,它会导致两个错误:

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

是否可以将当前工作表导出为文件,但继续在原始文件中工作?

am46iovg

am46iovg1#

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

xzlaal3s2#

几乎是我想要的@Ralph,但这里是最好的答案,因为它解决了你代码中的一些问题:
1.它导出当前工作表,而不仅仅是名为“Sheet 1”的硬编码工作表;
1.它将导出到名为当前工作表的文件
1.它遵守区域分隔字符。
1.继续编辑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

注意上面代码的一些特征:
1.它只适用于当前文件名有4个字母的情况,如. xlsm。不适用于.xls Excel旧文件。对于3个字符的文件扩展名,在上面的代码中设置MyFileName时,必须将- 5更改为- 4
1.作为一个附带的效果,您的剪贴板将被替换为当前的工作表内容。
编辑:将Local:=True放入保存,并使用我的区域设置CSV文件。

flvtvl50

flvtvl503#

根据我在@neves帖子上的评论,我通过添加xlPastebs和值部分稍微改进了这一点,这样日期就可以作为日期进行-我主要是保存为银行对账单的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
ymzxtsji

ymzxtsji4#

这里有一个轻微的改进,在同一个例程中同时处理.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
0wi1tuuw

0wi1tuuw5#

对于那些需要更多自定义输出(分隔符或十进制符号)的情况,或者当你有一个大数据集(超过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
ldxq2e6h

ldxq2e6h6#

1.您可以使用不带参数的复制.Copy将工作表复制到新工作簿。复制.移动将工作表复制到新工作簿,并将其从原始工作簿中删除(您可能会说“导出”它)。
1.获取新创建的工作簿的引用并保存为CSV。
1.将DisplayAlerts设置为false以禁止显示警告消息。(不要忘记在你完成后打开它)。
1.您希望在保存工作簿和关闭工作簿时关闭DisplayAlerts。

wsToExport.Move

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

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

wwtsj6pe7#

正如我所评论的,这个网站上有几个地方可以将工作表的内容写入CSV。This onethis 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

相关问题