VBA只复制excel中的特定列以导出为csv。
试图用我需要的数据将excel工作表转换为csv。基本上，我只需要导出包含数据的列。我对使用vba宏非常陌生。我制作了一个工作表，其中的单元格链接到A:AF列中第一行的组合框上。问题是，当我试图将工作表直接保存为csv或使用下面的宏导出时，这些与组合框链接的单元似乎被视为数据。第一个(列标题/变量名称)行的示例，然后是我理想中在导出的csv中看到的一个观察的第一行示例：
Author,Year,Yield,Treatment
Smith,1999,2.6,notillAuthor...Treatment行最初来自验证列表中的选择，受限制的单元格链接到组合框，而Smith...notill观察则是我粘贴的内容。相反，我看到的例子是：
Author,Year,Yield,Treatment,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
Smith,1999,2.6,notill,,,,,,,,,,,,,,,,,,,,,,,,,,,,,下面的所有观察行都是相同数量的列。这会产生问题，因为我现在有了新的变量，如果我在SAS中获得名称，这些变量就会合并。我不能指定列，因为每次创建并导出这些列时，都会有不同数量的列。如果您想要的列是已知的，那么有一些方法可以处理这个问题，例如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当每个工作表中没有一致的列数时，要将其仅复制到实际输入数据的列中？或者其他能完成任务的东西。非常感谢！
回答 2
Stack Overflow用户
发布于 2017-08-04 14:38:06
测试这段代码。
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 SubStack Overflow用户
发布于 2017-08-04 14:34:46
你可以用不同的方式来处理这个问题。我会这么做的。将新工作表添加到工作簿中。函数中有一个FOR循环来遍历工作表中的所有列。对于每一列，您可以使用类似的内容来检查它是否包含任何数据：
iDataCount = Application.WorksheetFunction.CountIf(<worksheet object>.Range(<your column i.e. `"F:F"`>), "<>" & "")如果iDataCount为0，那么您就知道该列为空。如果它不是0，就把它复制到新的工作表中。完成FOR循环后，将新工作表复制到.csv文件中。最后，将新工作表从您的工作簿中删除(或者您可以将它留在那里。如果您这样做了，您只需清除它之前，您运行的进程下一次。这也可以通过代码来完成)
https://stackoverflow.com/questions/45508540
复制相似问题
腾讯云开发者
