VBA Excel打开已关闭的文件并复制特定列，然后保存到不同的文件
VBA Excel打开已关闭的文件并复制特定列，然后保存到不同的文件
提问于 2020-08-12 04:19:58
我有一个关闭的csv文件，我需要通过从另一个文件运行宏来处理它。按ID或名称复制特定列，然后将它们保存在磁盘的不同文件中。
我试过修改这段代码，但在尝试从另一个文件实现它时遇到了问题，我正在测试的代码将数据复制到运行该代码的同一文件中。
还可以在新创建的文件的第一行和第二行添加标题和标题吗？
Sub test()
Dim mywb As Workbook, wb As Workbook
Dim sh As Worksheet
Set mywb = ThisWorkbook
Dim vFile
Dim fn
Dim x As Integer, t As Integer
Dim v As Variant, vName As Variant
' Specify the colum numbers to be copied. column 1 is ID 1
v = Array(1, 2, 3, 4, 5, 6, 11, 12, 55, 67)
vFile = Application.GetOpenFilename("CSV Files(*.csv),*.csv", , "please select a file", MultiSelect:=False)
'vFile = "test.csv"
If vFile = False Then Exit Sub
'
vName = Split(vFile, "\")
vName = Replace(vName(UBound(v)), ".csv", "")
'vName = "Sheet2"
Application.ScreenUpdating = False
Set sh = mywb.Sheets.Add(before:=mywb.Sheets(1))
sh.Name = vName
Workbooks.OpenText Filename:=vFile, Local:=True
Set wb = ActiveWorkbook
'copying columns assigned in v array
t = 1
For x = 0 To UBound(v)
wb.Sheets(1).Columns(v(x)).Copy sh.Cells(1, t)
t = t + 1
Next
sh.UsedRange.EntireColumn.AutoFit
wb.Close False
'Creating CSV file
fn = vName & ".csv"
sh.Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "OUTPUT.CSV"
ActiveWorkbook.Close False
sh.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
end sub回答 2
Stack Overflow用户
发布于 2020-08-12 05:23:54
试试这个：
Sub test()
Dim wb As Workbook, sh As Worksheet
Dim vFile, arr, fn
Dim x As Long
Dim v As Variant, vName As Variant
' Specify the colum numbers to be copied. column 1 is ID 1
v = Array(1, 2, 3, 4, 5, 6, 11, 12, 55, 67)
vFile = Application.GetOpenFilename("CSV Files(*.csv),*.csv", , "please select a file", MultiSelect:=False)
If vFile = False Then Exit Sub
arr = Split(vFile, "\")
fn = arr(UBound(arr))
Workbooks.OpenText fileName:=vFile, Local:=True
Set wb = Workbooks(fn)
Set sh = wb.Sheets.Add(after:=wb.Sheets(1)) 'add new sheet
'copying columns assigned in v array to the new sheet
For x = 0 To UBound(v)
wb.Sheets(1).Columns(v(x)).Copy sh.Cells(1, x + 1)
'sh.Columns(x+1).Value = wb.Sheets(1).Columns(v(x)).Value 'copy values only
Next
sh.UsedRange.EntireColumn.AutoFit
Application.DisplayAlerts = False
wb.Sheets(1).Delete 'remove the original data
Application.DisplayAlerts = True
wb.SaveAs wb.Path & "\" & "OUTPUT.CSV"
wb.Close False
End SubStack Overflow用户
发布于 2020-08-12 05:28:02
如果你不说出你有什么问题，就很难说出如何预防它们。据猜测，你可能遇到的一件事是列高度-当你试图复制整个列时，Excel有时会做一些奇怪的事情，从csv文件复制到某些版本。如果这听起来很熟悉，只需复制整列和页面使用范围的交集，而不是整列。
关于添加报头之类的--是的，这很简单。在接近末尾的地方，你得到了这段代码(顺便说一句，除非你按照上面的建议切换到交叉点，否则这是不起作用的，所以你会想把CopyRange调暗为Range)：
For x = 0 To UBound(v)
wb.Sheets(1).Columns(v(x)).Copy sh.Cells(1, t)
t = t + 1
Next只需粘贴到第三行，并在以下位置添加标题：
For x = 0 To UBound(v)
Set CopyRange = Intersect(wb.Sheets(1).Columns(v(x), wb.sheets(1).UsedRange)
CopyRange.Copy sh.Cells(3, t)
sh.Cells(1,t).value="Put a title here"
sh.Cells(2,t).value="Put a header here"
t = t + 1
Next显然，您可能希望它们有所不同，所以不是硬编码字符串，而是使用相应修改的变量或数组(字符串数组可以很好地工作，然后您可以只执行TitleArray(t)和HeaderArray(t))。
祝好运!
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/63365826
复制相关文章
相似问题
腾讯云开发者
