代码之家 › 专栏 › 技术社区 › nolags

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

xlsx vbscript excel

0

nolags · 技术社区 · 8 年前

我有一个包含很多列和行的xlsx文件。我需要选择sepcific列来生成一个新的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()

但这并没有复制整个专栏。我怎样才能解决这个问题?

1 回复 | 直到 8 年前

1

user6432984 user6432984 8 年前

我无法复制你的错误,但这里有一些提示。

您不应该使用括号调用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