导出为CSV

我想导出到CSV，而不是“另存为”，所以创build一个button，将由macros启用。 单击时，它应该在指定的目录中创build第一个工作表的.csv文件，并指定名称。 而我原来的工作表应该保留，而不是保存为。

Answer 1

如果要保持原始工作簿不变，那么为什么不创造。 我们可以将工作表复制到另一个工作簿并保存为.csv

Option Explicit Sub ExportOneSheet() Const strFILE_NAME As String = "C:\Users\Tom\Desktop\tes.csv" Dim shToExport As Worksheet ' Set the sheet to copy Set shToExport = ActiveWorkbook.Sheets("Sheet1") ' Make a copy of the sheet, when called without argument ' it will create a new workbook shToExport.Copy Set shToExport = ActiveWorkbook.Sheets("Sheet1") ' If the file exists the delete it. This will esure that ' there is no previous file so the replace file thing will not show If Not Dir$(strFILE_NAME, vbNormal) = vbNullString Then Kill strFILE_NAME End If ' Use Save As and your original workbook stays untouched. shToExport.SaveAs strFILE_NAME, XlFileFormat.xlCSV shToExport.Parent.Close True End Sub 

我希望这有帮助 ：）

Answer 2

如果在单元格中没有embedded逗号，这可能就足够了：

 Sub CSV_Maker() Dim r As Range Dim sOut As String, k As Long, M As Long Dim N As Long, nFirstRow As Long, nLastRow As Long Sheets(1).Select ActiveSheet.UsedRange Set r = ActiveSheet.UsedRange nLastRow = r.Rows.Count + r.Row - 1 nFirstRow = r.Row Dim separator As String separator = "," MyFilePath = "C:\TestFolder\" MyFileName = "whatever" Set fs = CreateObject("Scripting.FileSystemObject") Set a = fs.CreateTextFile(MyFilePath & MyFileName & ".csv", True) For N = nFirstRow To nLastRow k = Application.WorksheetFunction.CountA(Cells(N, 1).EntireRow) sOut = "" If k = 0 Then sOut = vbCrLf Else M = Cells(N, Columns.Count).End(xlToLeft).Column For mm = 1 To M sOut = sOut & Cells(N, mm).Value & separator Next mm sOut = Left(sOut, Len(sOut) - 1) End If a.writeline (sOut) Next a.Close End Sub