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中包含不同数量的列。如果这确实是你想要做的，那么我认为最快的方法是将结果写入文件，如下所示。对于20,000行

，大约需要1秒钟

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

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

1 个答案: