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

Question

试图将excel工作表转换为仅包含我需要的数据的csv。基本上我只需要导出包含数据的列。我很新使用vba宏。我制作了一个工作表，单元格链接到组合框A列AF中的第一行。问题是，当我尝试直接将工作表保存为csv或使用下面的宏进行导出时，似乎这些组合框链接的单元格会被视为数据。第一（列标题/变量名）线的 实例，然后一个观察的例子第一行，我会非常的导出的csv看到：

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

在这里笔者...处理生产线最初来自选择在链接到组合框和史密斯验证列表限定小区... 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文件中。最后从你的工作簿中删除新的工作表（或者你可以把它留在那里，如果你这样做，你只需要在下一次运行该过程之前将其清除..也可以通过代码完成）