vba VB 宏 - 通过从不同的电子表格复制相关数据来创建 CSV 文件
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/5119202/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VB Macro - Create CSV file by copying relevant data from different spreadsheets
提问by Elen
i don't write on VB, but i need a script to do some work for me. if someone could help... I have a folder1 with excel files in it. I have a Additional1 sheet with some additional data.
我不写在 VB 上，但我需要一个脚本来为我做一些工作。如果有人可以帮忙...我有一个文件夹1，里面有excel文件。我有一个包含一些额外数据的 Additional1 表。
- I need a macro to go thru folder1 reading files and copying certain columns into a CSV file (can be a new or using template) with certain headers in first row.
- Then looking by a cat number in Additional1 copy some additional data from certain columns
- and then saving this new CSV under the name which can be found under a specific header in the excel file which we are reading from folder1.
- 我需要一个宏来通过 folder1 读取文件并将某些列复制到一个 CSV 文件（可以是新的或使用模板）中，第一行的某些标题。
- 然后通过 Additional1 中的猫号从某些列中复制一些额外的数据
- 然后将这个新的 CSV 保存在名称下，该名称可以在我们从文件夹 1 读取的 excel 文件的特定标题下找到。
here is the content of one of the files from folder1
这是文件夹 1 中其中一个文件的内容
Aritst Year Manufacturer UPC Catalog No Track # Track Name
Blackfield 2007 8.02645E+11 KSCOPE126M 1 Once
Blackfield 2007 8.02645E+11 KSCOPE126M 2 Bla People
Blackfield 2007 8.02645E+11 KSCOPE126M 3 Miss U
Blackfield 2007 8.02645E+11 KSCOPE126M 4 Christenings
Say I need only
说我只需要
A, B, D and F columns copied to
A、B、D 和 F 列复制到
K, E, A and AD
K、E、A 和 AD
of the CSV file correspondingly (i.e. CSV Column A will contain data of column D of opened spreadsheet - in above example Catalog No)
对应的 CSV 文件（即 CSV 列 A 将包含打开的电子表格的 D 列的数据 - 在上面的示例中目录号）
here is the code I've got:
这是我得到的代码：
Sub Convert_to_Digi()
' First delete existing data
Dim LastRow As Long
Dim SrcWkb As Workbook
Dim StartRow As Long
Dim wkbname As Variant
Dim xlsFiles As Variant
Dim MyRange As Variant
Dim NewName As Variant
StartRow = 2
' Get the workbooks to open
xlsFiles = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls", MultiSelect:=True)
If VarType(xlsFiles) = vbBoolean Then Exit Sub
' Loop through each workbook and copy the data to this CSV
For Each wkbname In xlsFiles
Set SrcWkb = Workbooks.Open(Filename:=wkbname, ReadOnly:=True)
MyRange = Sheets("export_label_conf").Range("A:A")
LastRow = Application.WorksheetFunction.CountA(MyRange)
Sheets("export_label_conf").Select
NewName = Cells(3, 2) & ".csv"
If LastRow >= StartRow Then
' copy column D data
With SrcWkb.Worksheets("export_label_conf")
.Range(.Range("D2"), .Range("D").LastRow).Copy
SrcWkb.Worksheets("export_label_conf").Select
Range("D2:D" & LastRow).Select
Selection.Copy
' paste into CSV template file
Workbooks.Open Filename:="C:\DIGITAL\template.csv", ReadOnly:=False
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
' and save template as new CSV with barcode as name
Name = CurDir & "\" & NewName
ActiveWorkbook.SaveAs Filename:= _
Name, FileFormat:= _
xlCSV, CreateBackup:=False
End If
SrcWkb.Close
Next wkbname
End Sub
I'm stuck with copying multiple columns at once into CSV file... and generally not sure if the script is written correctly =) can someone give me a hand on this please?
我坚持一次将多个列复制到 CSV 文件中......并且通常不确定脚本是否正确编写 =) 有人可以帮我解决这个问题吗？
UPDATE 28.02.11 11:23
更新 28.02.11 11:23
epic fail on trying to implement vlookup =)
尝试实现 vlookup 的史诗失败 =)
'vlookup additional data from a spreadsheet
'从电子表格中查找附加数据
Dim FndStr As String
Dim FndVal As Range
Dim addWkb As Variant
Dim AddInfo As String
' copy column E
FndStr = MyRange.Columns(12).Value
Set addWkb = Workbooks.Open(Filename:="C:\DIGITAL\Snapper Owned Licensed Catalogue.xls", ReadOnly:=True)
Set FndVal = Columns("B:B").Find(What:=FndStr, LookAt:=xlWhole)
If FndVal Is Nothing Then
MsgBox "ID not found!!"
Else
'get value of column D
AddInfo = FndVal.Offset(0, 3).Value
End If
' paste into CSV template file, ADDITIONAL INFO into AO column
csvWkb.ActiveSheet.Cells(2, 41).PasteSpecial Paste:=AddInfo, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
i pasted this before "and save template as new CSV with barcode as name" in Chris's code edit... Help please? how do i loop thru the column and vlookup each value?
我在 Chris 的代码编辑中“将模板另存为新的 CSV 并以条形码为名称”之前粘贴了这个...请帮忙？我如何遍历列并查找每个值？
采纳答案by chris neilsen
regarding copy of multiple columns, it is possible (eg Range("A2:A4,B2:B4,D2:D4,F2:F4").Copy), but when you paste them they will be in a continuous range - better to just copy separately
关于多列的复制，这是可能的（例如Range("A2:A4,B2:B4,D2:D4,F2:F4").Copy），但是当您粘贴它们时，它们将在一个连续的范围内 - 最好单独复制
I've re-factored your code give you some hints
我已经重构了你的代码给你一些提示
Sub Convert_to_Digi()
' First delete existing data
Dim SrcWkb As Workbook
Dim csvWkb As Workbook
Dim srcSheet As Worksheet
Dim StartRow As Long
Dim wkbname As Variant
Dim xlsFiles As Variant
Dim MyRange As Range
Dim NewName As Variant
Dim csvName As String
StartRow = 2
' Get the workbooks to open
xlsFiles = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls", MultiSelect:=True)
If VarType(xlsFiles) = vbBoolean Then Exit Sub
' Loop through each workbook and copy the data to this CSV
For Each wkbname In xlsFiles
Set SrcWkb = Workbooks.Open(Filename:=wkbname, ReadOnly:=False)
Set srcSheet = SrcWkb.Worksheets("export_label_conf")
' Get used range on sheet
Set MyRange = srcSheet.UsedRange
' Adjust to exclude top row
Set MyRange = MyRange.Offset(1, 0).Resize(MyRange.Rows.Count - 1)
NewName = srcSheet.Cells(3, 2) & ".csv"
If MyRange.Row + MyRange.Rows.Count - 1 >= StartRow Then
Set csvWkb = Workbooks.Open(Filename:="C:\DIGITAL\template.csv", ReadOnly:=False)
' copy column A
MyRange.Columns(1).Copy
' paste into CSV template file, column K
csvWkb.ActiveSheet.Cells(2, 11).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
' copy column B
MyRange.Columns(4).Copy
' paste into CSV template file
csvWkb.ActiveSheet.Cells(2, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
' copy column D
MyRange.Columns(4).Copy
' paste into CSV template file, column A
csvWkb.ActiveSheet.Cells(2, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
' copy column F
MyRange.Columns(6).Copy
' paste into CSV template file, column AD
csvWkb.ActiveSheet.Cells(2, 30).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
' and save template as new CSV with barcode as name
csvName = CurDir & "\" & NewName ' using CurDir is a bit dangerous: how do you know what its set to?
ActiveWorkbook.SaveAs Filename:=csvName, FileFormat:=xlCSV, CreateBackup:=False
End If
SrcWkb.Close
Next wkbname
End Sub
