VBA Excel打开关闭的文件并复制特定的列，然后保存到其他文件

如何解决VBA Excel打开关闭的文件并复制特定的列，然后保存到其他文件

我有一个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

解决方法

尝试一下：

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 Sub

,

如果您不说自己遇到的问题，那么很难说出如何预防这些问题。猜测，您可能会遇到的一件事就是列高-当您尝试复制整个列时，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））。

祝你好运！