将数据导出到单个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 

一种解决方案可能是使用偏移或调整大小来更改VB代码中UsedRange。另一个可能是创建一个RealRange变量，然后selectcopy。

类似样的问题已被要求不止一次，像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