将数据范围导出到单个 CSV 文件

Question

使用 VBA 将包含 Excel 2010 数据的特定单元格范围导出到 CSV 的有效方法是什么？数据始终从单元格 A3 开始。范围的结尾取决于数据集（始终是 Q 列，但行结尾可能会有所不同）。它应该只从名为“内容”的工作表 2 中导出数据，并且单元格只需要包含“真实”数据，如文本或数字，而不是带有公式的空值。

单元格具有公式的原因是它们引用了工作表 1 和 3 中的单元格。公式使用正常引用和垂直搜索。

使用 UsedRange 将导出 Excel 使用的所有单元格。这可行，但它最终也会导出所有包含公式的空单元格，但没有数据导致输出 .csv 中出现大量不必要的分号（准确地说是 510）。

Sub SavetoCSV()
    Dim Fname As String
 Sheets("Content").UsedRange.Select
 Selection.Copy
 Fname = "C:\Test\test.csv"
    Workbooks.Add
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs Filename:=Fname, _
    FileFormat:=xlCSV, CreateBackup:=False, local:=True
    Application.DisplayAlerts = False
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
End Sub

一种解决方案可能是使用 Offset 或 Resize 更改 VB 代码中的 UsedRange。另一个可能是创建一个 RealRange 变量，然后选择复制它。

类似的问题被问了不止一次，比如here、here 和here，我也看过 SpecialCells，但不知怎的，我无法让它按照我想要的方式工作.

我已经尝试了下面的代码，但它最终也从表 3 中添加了行。

 Sub ExportToCSV()
 Dim Fname As String
 Dim RealRange As String
 Dim Startrow As Integer
 Dim Lastrow As Integer
 Dim RowNr As Integer

 Startrow = 3
 RowNr = Worksheets("Content").Cells(1, 1).Value 'this cells has a MAX function returning highest row nr
 Lastrow = RowNr + 3
 RealRange = "A" & Startrow & ":" & "Q" & Lastrow

 Sheets("Content").Range(RealRange).Select
 Selection.Copy
 Fname = "C:\Test\test.csv"
    Workbooks.Add
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs Filename:=Fname, _
    FileFormat:=xlCSV, CreateBackup:=False, local:=True
    Application.DisplayAlerts = False
    'ActiveWorkbook.Close
    Application.DisplayAlerts = True
End Sub

如果我看错了方向，请参考其他选项。

Answer 1

如果我理解，您只想导出包含值的单元格。这将导致 csv 中包含不同数量的列。如果这确实是您想要做的，那么我认为最快的方法是将您的结果写入如下文件。这在大约 1 秒内运行了 20,000 行

Dim Lastrow As Integer
Dim RowNr As Integer
Dim SourceSheet As Worksheet
Const Fname As String = "C:\Test\test.csv"
Const StartRow As Integer = 3
Sub ExportToCSV()
On Error GoTo errorhandler
Set SourceSheet = Worksheets("Content")
    TargetFileNumber = FreeFile()
    Open Fname For Output As #TargetFileNumber 'create the file for writing
    Lastrow = SourceSheet.Cells(1, 1).Value + 3 'I would just use the used range to count the rows but whatever
    For r = StartRow To Lastrow 'set up two loops to go through the rows column by column
        Line = ""
        If SourceSheet.Cells(r, 1).Value <> "" Then 'check if there is a value in the cell, if so export whole row
            For c = 1 To 17 'Columns A through Q                
                Line = Line & SourceSheet.Cells(r, c).Value & "," 'build the line                
            Next c
        Line = Left(Line, Len(Line) - 1) 'strip off last comma
        Print #TargetFileNumber, Line 'write the line to the file
    End If
    Next r
 GoTo cleanup
errorhandler:
MsgBox Err.Number & " --> " & Err.Description, vbCritical, "There was a problem!"
cleanup:
Close #TargetFileNumber
End Sub