有没有办法将批量范围写入文本/ CSV文件？
我习惯使用VBA中的write命令将一系列单元格的内容（值）写入文本文件，例如：
write #myfile, Range("A1").value, Range("A2).value, Range("A3).value
是否存在一个更优雅和方便的内置方法来将整个范围直接转储到分隔文件，甚至可能一次覆盖多行？ 还是有人提出了一个定制的解决scheme？ 我认为这将是非常有用的。
我给你写的这个东西还是可以改进的，但是我觉得这样很好：
Sub SaveRangeAsCSV(r As Range, filename As String, overwrite As Boolean) Dim wB As Workbook Dim c As Range Dim usedRows As Long If overwrite Then If Dir(filename) <> "" Then Kill filename If Err.Number <> 0 Then MsgBox "Could not delete previously existing file." & vbNewLine & Err.Number & ": " & Err.Description Exit Sub End If End If If Dir(filename) <> "" Then Set wB = Workbooks.Open(filename) Else Set wB = Workbooks.Add End If With wB.Sheets(1) usedRows = .UsedRange.Rows.Count 'Check if more than 1 row is in the used range. If usedRows = 1 Then 'Since there's only 1 row, see if there's more than 1 cell. If .UsedRange.Cells.Count = 1 Then 'Since there's only 1 cell, check the contents If .Cells(1, 1) = "" Then 'you're dealing with a blank workbook usedRows = 0 End If End If End If 'Check if range is contigious If InStr(r.Address, ",") Then For Each c In r.Cells .Range(c.Address).Offset(usedRows, 0).Value = c.Value Next Else .Range(r.Address).Offset(usedRows, 0).Value = r.Value End If End With wB.SaveAs filename, xlCSV, , , , False wB.Saved = True wB.Close End Sub Sub Example() 'I used Selection here just to make it easier to test. 'Substitute your actual range, and actual desired filepath 'If you pass false for overwrite, it assumes you want to append 'It will give you a pop-up asking if you want to overwrite, which I could avoid 'by copying the worksheet and then closing and deleting the file etc... but I 'already spent enough time on this one. SaveRangeAsCSV Selection, "C:\proofOfConcept.csv", False End Sub
使用它时，只需提供实际的范围，实际的文件名以及是否要覆盖文件。 :)这已被更新，以允许不连续的范围。 对于合并的单元格，它将最终将值放入合并范围的第一个单元格中。
这是我自己提出的解决scheme，最适合我所见：
Sub DumpRangeToTextFile(filehandle As Integer, source As Range) Dim row_range As Range, mycell As Range For Each row_range In source.rows For Each mycell In row_range.cells Write #filehandle, mycell.Value; Next mycell Write #filehandle, Next row_range End Sub
简短而甜美！ ;）
我仍然给丹尼尔·库克的解决scheme，这也是非常有用的应有的功劳。
从我的文章使用Excel VBA创build和写入CSV文件
本文提供了两个VBA代码示例来创build和写入CSV文件：
- 使用Open For Output作为FreeFile创build一个CSV文件。
- 使用FileSystemObject对象创build一个CSV文件。
我更喜欢后一种方法，主要是因为我正在使用FileSystemObject进一步编码，例如recursion处理子文件夹中的所有文件（尽pipe本文中未使用该技术）。
代码注释
此代码必须从常规的VBA代码模块运行。 否则，如果用户尝试从给定Const的用法的ThisWorkbook或Sheet Code窗格中运行代码，则代码将会导致错误。
值得注意的是，ThisWorkbook和Sheet代码部分应该只保留给事件编码，“正常”的VBA应该从标准的代码模块运行。
请注意，出于示例代码的目的，CSV输出文件的文件path是“硬编码”，如代码顶部的C：\ test \ myfile.csv。 您可能需要以编程方式设置输出文件，例如作为函数参数。
如前面提到的; 举例来说，这个代码TRANSPOSES COLUMNS AND ROWS; 也就是说，输出文件包含所选范围中每列的一个CSV行。 通常情况下，CSV输出将是逐行的，回显屏幕上可见的布局，但我想演示使用VBA代码生成输出提供超出可用的选项，例如，使用另存为… CSV文本菜单选项。
码
Const sFilePath = "C:\test\myfile.csv" Const strDelim = "," 'Option 1 Sub CreateCSV_Output() Dim ws As Worksheet Dim rng1 As Range Dim X Dim lRow As Long Dim lCol As Long Dim strTmp As String Dim lFnum As Long lFnum = FreeFile Open sFilePath For Output As lFnum For Each ws In ActiveWorkbook.Worksheets 'test that sheet has been used Set rng1 = ws.UsedRange If Not rng1 Is Nothing Then 'only multi-cell ranges can be written to a 2D array If rng1.Cells.Count > 1 Then X = ws.UsedRange.Value2 'The code TRANSPOSES COLUMNS AND ROWS by writing strings column by column For lCol = 1 To UBound(X, 2) 'write initial value outside the loop strTmp = IIf(InStr(X(1, lCol), strDelim) > 0, """" & X(1, lCol) & """", X(1, lCol)) For lRow = 2 To UBound(X, 1) 'concatenate long string & (short string with short string) strTmp = strTmp & (strDelim & IIf(InStr(X(lRow, lCol), strDelim) > 0, """" & X(lRow, lCol) & """", X(lRow, lCol))) Next lRow 'write each line to CSV Print #lFnum, strTmp Next lCol Else Print #lFnum, IIf(InStr(ws.UsedRange.Value, strDelim) > 0, """" & ws.UsedRange.Value & """", ws.UsedRange.Value) End If End If Next ws Close lFnum MsgBox "Done!", vbOKOnly End Sub 'Option 2 Sub CreateCSV_FSO() Dim objFSO Dim objTF Dim ws As Worksheet Dim lRow As Long Dim lCol As Long Dim strTmp As String Dim lFnum As Long Set objFSO = CreateObject("scripting.filesystemobject") Set objTF = objFSO.createtextfile(sFilePath, True, False) For Each ws In ActiveWorkbook.Worksheets 'test that sheet has been used Set rng1 = ws.UsedRange If Not rng1 Is Nothing Then 'only multi-cell ranges can be written to a 2D array If rng1.Cells.Count > 1 Then X = ws.UsedRange.Value2 'The code TRANSPOSES COLUMNS AND ROWS by writing strings column by column For lCol = 1 To UBound(X, 2) 'write initial value outside the loop strTmp = IIf(InStr(X(1, lCol), strDelim) > 0, """" & X(1, lCol) & """", X(1, lCol)) For lRow = 2 To UBound(X, 1) 'concatenate long string & (short string with short string) strTmp = strTmp & (strDelim & IIf(InStr(X(lRow, lCol), strDelim) > 0, """" & X(lRow, lCol) & """", X(lRow, lCol))) Next lRow 'write each line to CSV objTF.writeline strTmp Next lCol Else objTF.writeline IIf(InStr(ws.UsedRange.Value, strDelim) > 0, """" & ws.UsedRange.Value & """", ws.UsedRange.Value) End If End If Next ws objTF.Close Set objFSO = Nothing MsgBox "Done!", vbOKOnly End Sub
上面的这些方法遍历单元格范围以导出数据。 由于所有的错误检查，任何通过循环遍历表单元格范围的任何操作都非常缓慢。
这是我没有迭代的方式。 基本上，它使用内置函数“Join（）”来完成繁重的工作，这将是您的迭代循环。 这要快得多。
相关的Read（）子程序I在另一篇文章中详细介绍： https : //stackoverflow.com/a/35688988/2800701
这是Write（）子例程（注意：这里假设你的文本在导出之前已经预先格式化为正确的工作表规范;它只能在单个列上工作…不在多个列范围内）：
Public Sub WriteRangeAsPlainText(ExportRange As Range, Optional textfilename As Variant) If IsMissing(textfilename) Then textfilename = Application.GetSaveAsFilename(FileFilter:="Text Files (*.txt), *.txt") If textfilename = "" Then Exit Sub Dim filenumber As Integer filenumber = FreeFile Open textfilename For Output As filenumber Dim textlines() As Variant, outputvar As Variant textlines = Application.Transpose(ExportRange.Value) outputvar = Join(textlines, vbCrLf) Print #filenumber, outputvar Close filenumber End Sub