将范围与数据导出到单个CSV文件 [英] Export range with data to single CSV file

问题描述

使用VBA将特定范围的单元格数据从Excel 2010导出到CSV的有效方法是什么?数据总是从单元格A3开始.范围的末端取决于数据集(总是列Q但行末端可能有所不同).它只应从工作表2中称为内容"的数据中导出数据，并且单元格只需要包含真实"数据(如文本或数字)，而不能包含带有公式的空值.

What is an efficient way to export a particular range of cells with data from Excel 2010 to CSV using VBA? The data always starts at cell A3. The end of the range depends on the dataset (always column Q but row end may vary). It should only export data from sheet 2 called 'Content' and the cells need to contain only 'real' data like text or numbers, not empty values with formulas.

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

The reason cells have formulas is because they reference cells from sheet 1 and 3. Formulas use normal reference and also vertical searches.

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

Using the UsedRange will export all the cells which are used by Excel. This works, but it also ends up exporting all the empty cells containing formulas but no data leading to lots (510 to be precise) of unnecessary semicolons in the output .csv.

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变量，然后选择复制它.

One solution might be to change the UsedRange in the VB code with Offset or Resize. Another might be to create a RealRange variable and then selectcopy that.

类似的问题已多次问过，例如此处，此处和此处，我也研究了SpecialCells，但是不知何故我无法使其正常工作我想要

Similar kind of questions have been asked more than once, like here, here and here, and I've also looked at SpecialCells, but somehow I cannot get it to work the way I want it to.

我尝试了下面的代码，但最终也添加了工作表3中的行.

I have tried the below code, but it ends up adding rows from sheet 3 as well.

 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

如果我朝错误的方向看，请参阅其他选项.

If I'm looking in the wrong direction, please refer to other options.

推荐答案

据我了解，如果单元格中有值，则只想导出该单元格.这将导致其中具有不同列数的csv.如果这确实是您要尝试的操作，那么我认为最快的方法是将结果写入文件，如下所示.大约1秒钟运行了20,000行

If I understand, you only want to export the cell if it has a value in it. This is going to lead to a csv with different numbers of columns in it. If that's truly what you are trying to do then the fastest way I think is writing your results to a file as below. This ran in about 1 second for 20,000 rows

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文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！