VBA复制只有特定的列在Excel中导出为CSV
试图把一个Excel工作表变成一个只有我需要的数据的CSV。 基本上我只需要导出包含数据的列。 我很新，使用VBAmacros。 我已经制作了一个工作表，单元格链接到comboboxA列AF中的第一行。 问题是，当我试图直接将工作表保存为csv或使用下面的macros进行导出时，似乎这些combobox链接的单元格被视为数据。 第一个（列标题/variables名称）行的示例，然后是我将在导出的csv中理想地看到的一个观察的示例第一行：
Author,Year,Yield,Treatment Smith,1999,2.6,notill 哪里作者…治疗线最初来自validation列表中的select限制单元格连接到combobox和史密斯… notill观察是我粘贴的东西。我所看到的例子：
Author,Year,Yield,Treatment,,,,,,,,,,,,,,,,,,,,,,,,,,,,, Smith,1999,2.6,notill,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
然后下面的所有观察行都是相同的列数。 这会产生问题，因为我现在有了新的variables，如果我在SAS中使用getname，就会搞乱合并。 我无法指定列，因为每次创build并导出时都有不同数量的列。 如果你想要的列是已知的，有办法处理这个问题 ，例如这个答案 。 但是我希望能够理想地说：“仅复制非空的列”，或者可以“只复制第一行中具有以下特定文本之一的列”，因为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
我知道这应该是非常简单的（没有任何内容的列应该以某种方式突出显示，对吗？），但我昨天search了4个小时，如何做到这一点。 我宁愿不要在每个工作表中以某种方式划定空列，我将变成一个csv。 有什么我可以添加到
Sheets("TxYdata").Copy
当我在每张表中没有一致的列数时，只把它复制到实际input数据的列上？ 或者其他能完成工作的东西。 非常感谢！
testing这个代码。
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
你可以用不同的方式来解决这个问题 这是我会做的。 将新的工作表添加到您的工作簿。 在你的函数中有一个FOR循环遍历表中的所有列。 对于每一列，你可以使用类似的东西来检查它是否包含任何数据：
iDataCount = Application.WorksheetFunction.CountIf(<worksheet object>.Range(<your column ie `"F:F"`>), "<>" & "")
如果iDataCount是0，那么你知道列是空的。 如果不是0，则将其复制到新的工作表中。 完成FOR循环后，将新工作表复制到.csv文件中。 最后从你的工作簿中删除新的工作表（或者你可以把它留在那里，如果你这样做的话，你只需要在下一次运行之前清除它），这也可以通过代码完成）