將數據導出到單個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