使用 vbscript 将特定列保存到新的 xlsx 文件

Save specific columns to new xlsx file with vbscript

我有一个包含很多列和行的 xlsx 文件。我需要 select 特定列来生成新的 xlsx 文件。
我的代码是:

Public Sub xlsToCsv()    
Dim WorkingDir
WorkingDir = "C:\test.xlsx"

Dim fso, FileName, SaveName, myFile
Dim objExcel, objWorkbook

Set fso = CreateObject("Scripting.FilesystemObject")
Set myFile = fso.GetFile(WorkingDir)

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = False
objExcel.DisplayAlerts = False

Set objWorkbook = objExcel.Workbooks.Open(myFile)

With objWorkbook.Sheets(1)
        .Range("D87", .Range("D87").End(-4121)).Copy
        objWorkbook.Sheets.Add().paste
        .Range("E87", .Range("E87").End(-4121)).Copy
End With

dim sheet: set sheet =  objWorkbook.Sheets.Add()
sheet.paste
objWorkbook.SaveAs("E:\test.csv"), 23
objWorkbook.Saved = true
objWorkbook.Close

Set objWorkbook = Nothing
Set objExcel = Nothing
Set fso = Nothing
Set myFolder = Nothing
End Sub
call xlsToCsv()

但这并没有复制整列。我该如何解决这个问题?

我无法重现您的错误,但这里有一些提示。

你不应该使用括号来调用一个 sub 并且还试图将它保存为不同的文件格式:objWorkbook.SaveAs("C:\test.xls").

这里只复制最后一个复制范围:

objWorkbook.Sheets(1).Range("D8").EntireColumn.Copy
objWorkbook.Sheets(1).Range("A8").EntireColumn.Copy
objWorkbook.Sheets(1).Range("F8").EntireColumn.Copy

更好的方法是使用Columns.Copy Destination复制数据。

objWorkbook.Sheets(1).Columns("D").Copy sheet.Columns("A")

Const WorkingDir = "C:\"
Const xlCSVMSDOS = 24
Dim fso, SaveName, myFile
Dim objExcel, objWorkbook, wsSource, wsTarget

myFile = "test.xlsx"
SaveName =WorkingDir & "test.csv"

With CreateObject("Scripting.FilesystemObject")
    If Not .FileExists(WorkingDir & myFile) Then
        MsgBox "File not found:" & vbCrLf & WorkingDir & myFile, vbInformation, "Script Cancelled"
        WScript.Quit
    End If
End With

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = False
objExcel.DisplayAlerts = False

Set objWorkbook = objExcel.Workbooks.Open(WorkingDir & myFile)
Set wsSource = objWorkbook.Sheets(1)
set wsTarget =  objWorkbook.Sheets.Add()

wsSource.Columns("D").Copy wsTarget.Columns("A")
wsSource.Columns("A").Copy wsTarget.Columns("B")
wsSource.Columns("F").Copy wsTarget.Columns("C")


objWorkbook.SaveAs SaveName, xlCSVMSDOS
objWorkbook.Close False

以下是从特定行开始的列复制数据的方法。

Const xlUp = -4162
With wsSource
    .Range("D87", .Range("D" & .Rows.Count).End(xlUp)).Copy wsTarget.Range("A1")
    .Range("A87", .Range("A" & .Rows.Count).End(xlUp)).Copy wsTarget.Range("B1")
    .Range("F87", .Range("F" & .Rows.Count).End(xlUp)).Copy wsTarget.Range("C1")
End With