Question

尝试将excel工作表转换为仅包含我需要的数据的csv。基本上我只需要导出包含数据的列。我很擅长使用vba宏。我已经制作了一个工作表，其单元格链接到组合框，用于A列中的第一行：AF。问题是，当我尝试直接将工作表保存为csv或使用下面的宏导出时，这些组合框链接的单元格似乎被视为数据。第一个（列标题/变量名称）行的示例，然后是我在理想情况下在导出的csv中看到的一个观察的示例第一行：

Author,Year,Yield,Treatment
Smith,1999,2.6,notill

作者......治疗线最初来自验证列表中的选择限制细胞链接到组合框和Smith ... notill观察是我粘贴的东西。我看到的例子：

Author,Year,Yield,Treatment,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
Smith,1999,2.6,notill,,,,,,,,,,,,,,,,,,,,,,,,,,,,,

然后下面的所有观察行都是相同的列数。这会产生问题，因为如果我在SAS中使用getnames，我现在有新的变量会搞乱合并。我无法指定列，因为每次创建然后导出列时，都会有不同数量的列。如果您想要的列已知，有多种方法可以解决此问题，例如this answer。但是我希望能够理想地说“只复制非空的列”，或者“只复制第一行中具有以下特定文本之一的列”，因为A2：AF2只能包含32个特定的东西中的一个，如果它们不是空的。这是我得到的代码，它将所有这些空白列复制到新工作簿并保存。

Sub CopyToCSV()
Dim MyPath As String
Dim MyFileName As String
'The path and file names:
MyPath = "C:\Users\Data\TxY\"
MyFileName = "TxY_" & Sheets("ValidationHeadings").Range("D3").Value & "_" & Format(Date, "ddmmyy")
'Makes sure the path name ends with "\":
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
'Makes sure the filename ends with ".csv"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
'Copies the sheet to a new workbook:
Sheets("TxYdata").Copy
'The new workbook becomes Activeworkbook:
With ActiveWorkbook
'Saves the new workbook to given folder / filename:

    .SaveAs Filename:= _
        MyPath & MyFileName, _
        FileFormat:=xlCSV, _
        CreateBackup:=False
'Closes the file
    .Close False
End With
End Sub

我知道这必须非常简单（其中没有任何内容的列应该以某种方式突出，对吧？）但我昨天搜索了4个小时如何做到这一点。我宁愿不在每个工作表中以某种方式划分空列，我将变成csv。有什么我可以添加到

Sheets("TxYdata").Copy

要让它只复制我实际输入数据的列，当我在每张表中没有一致的列数时？或其他可以完成工作的东西。非常感谢！

Answer 1

测试此代码。

Sub TransToCSV()

    Dim vDB, vR() As String, vTxt()
    Dim i As Long, n As Long, j As Integer
    Dim objStream
    Dim strTxt As String
    Dim rngDB As Range, Ws As Worksheet
    Dim MyPath As String, myFileName As String
    Dim FullName As String


    MyPath = "C:\Users\Data\TxY\"
    myFileName = "TxY_" & Sheets("ValidationHeadings").Range("D3").Value & "_" & Format(Date, "ddmmyy")
    If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
    If Not Right(myFileName, 4) = ".csv" Then myFileName = myFileName & ".csv"
    FullName = MyPath & myFileName

    Set Ws = Sheets("TxYdata")
    Set objStream = CreateObject("ADODB.Stream")

    With Ws
        Set rngDB = .Range("a1", "d" & .Range("a" & Rows.Count).End(xlUp).Row)
        'Set rngDB = .Range("a1").CurrentRegion <~~ Else use this codle
    End With

    vDB = rngDB
    For i = 1 To UBound(vDB, 1)
        n = n + 1
        ReDim vR(1 To UBound(vDB, 2))
        For j = 1 To UBound(vDB, 2)
            vR(j) = vDB(i, j)
        Next j
        ReDim Preserve vTxt(1 To n)
        vTxt(n) = Join(vR, ",")
    Next i
    strTxt = Join(vTxt, vbCrLf)

    With objStream
        '.Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile FullName, 2
        .Close
    End With
    Set objStream = Nothing

End Sub

Answer 2

你可以用不同的方式来解决这个问题。这就是我要做的。将新工作表添加到工作簿。在函数中使用FOR循环来遍历工作表中的所有列。对于每一列，您可以使用类似的内容来检查它是否包含任何数据：

iDataCount = Application.WorksheetFunction.CountIf(<worksheet object>.Range(<your column i.e. `"F:F"`>), "<>" & "")

如果 iDataCount 为0，则表示该列为空。如果它不是0，则将其复制到新工作表中。完成FOR循环后，将新工作表复制到.csv文件中。最后从工作簿中删除新工作表（或者你可以把它留在那里。如果你这样做，你只需要在下次运行流程之前清除它......也可以通过代码完成）

VBA只复制excel中的特定列以导出为csv

2 个答案: