将数据导出到单个CSV文件
使用VBA将Excel 2010中的数据导出为CSV格式的特定范围的单元格的有效方法是什么？ 数据总是从单元格A3开始。 范围的结尾取决于数据集（总是列Q，但行结束可能会有所不同）。 它应该只从名为“内容”的工作表2导出数据，而单元格只需包含“真实”数据（如文本或数字），而不是包含公式的空值。
单元格具有公式的原因是因为它们引用表1和3中的单元格。公式使用常规引用和垂直search。
使用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 一种解决scheme可能是用Offset或Resize来改变VB代码中的UsedRange。 另一个可能是创build一个RealRangevariables，然后selectcopy。
类似的问题已经被不止一次地问过，就像这里 ， 这里和这里一样 ，我也看了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
如果我查错了方向，请参考其他选项。
如果我明白，你只想导出单元格，如果它有一个值。 这将导致一个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