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

尝试将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，我现在有了新的变量，这些变量会扰乱合并。我无法指定列，因为每次创建并导出该列时，都会有不同数量的列。如果你想要的栏目是已知的，有很多方法可以解决这个问题。但我希望能够说，理想情况下“只复制不为空的列”，或者“只复制第一行中包含以下特定文本之一的列”，因为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

在每张工作表中的列数不一致的情况下，只复制实际输入数据的列？或者其他能完成任务的东西。

---

非常感谢

你可以用不同的方法来解决这个问题。这就是我要做的。将新工作表添加到工作簿中。在函数中使用

FOR

循环遍历工作表中的所有列。对于每一列，您都可以使用类似的方法来检查它是否包含任何数据：

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

iDataCount=Application.WorksheetFunction.CountIf（.Range（），“&”）

如果

iDataCount

为0，则表示该列为空。如果不是0，请将其复制到新工作表中。完成

FOR

循环后，将新工作表复制到

.csv

文件中。最后，从工作簿中删除新工作表（或者您可以将其留在工作簿中。如果这样做，您只需在下次运行流程之前将其清除即可。这也可以通过代码完成）

测试此代码

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

Sub TransToCSV（）
Dim vDB，vR（）作为字符串，vTxt（）作为字符串
尺寸i等于长，n等于长，j等于整数
暗流
作为字符串的Dim strText
尺寸rngDB作为范围，Ws作为工作表
将MyPath设置为字符串，将myFileName设置为字符串
将全名设置为字符串
MyPath=“C:\Users\Data\TxY\”
myFileName=“TxY_u2;”和Sheets（“ValidationHeaders”）.范围（“D3”）.值和格式（日期，“ddmmyy”）
如果不正确（MyPath，1）=“\”则MyPath=MyPath&“\”
如果不正确（myFileName，4）=“.csv”，则myFileName=myFileName&“.csv”
FullName=MyPath&myFileName
设置Ws=图纸（“TxYdata”）
设置objStream=CreateObject（“ADODB.Stream”）
与Ws
设置rngDB=.Range（“a1”、“d”和.Range（“a”和Rows.Count）.End（xlUp.Row）
'Set rngDB=.Range（“a1”）.CurrentRegion我使用了
Set rngDB=.Range（“a1”）.CurrentRegion
，它工作了。
Set rngDB=.Range（“a1”、“d”和.Range（“a”和Rows.Count）.End（xlUp.Row）
适用于a:d列。谢谢