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

Question

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

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

Author...Treatment 行最初来自与组合框和 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 文件中。最后从您的工作簿中删除新工作表（或者您可以将其留在那里。如果这样做，您只需在下次运行该过程之前清除它......这也可以通过代码完成）