Question

我一直在寻找一个代码VBScript，它可以将excel工作簿拆分成多个较小的工作簿。

在Stackoverflow上我遇到了一个完美的answer。唯一的问题是它是VBA而不是VBScript。我一直试图自己转换，但无法做到这一点。任何人都可以帮助我做到这一点。这是VBA：

Sub test()
    Dim names As New Collection
    Dim ws As Worksheet, ws1 As Worksheet
    Dim wb As Workbook
    Dim lastrow As Long
    Dim cell As Range
    Dim nm As Variant
    Dim res As Range
    Dim rngHeader As Range

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    With ws
        'change "A" to column with "Names"
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

        'change "A" to column with "Names"
        For Each cell In .Range("A2:A" & lastrow)
            On Error Resume Next
            'collect unique names
            names.Add CStr(cell.Value), CStr(cell.Value)
            On Error GoTo 0
        Next cell

        'disable all filters
        .AutoFilterMode = False

        'change "A1:C1" to headers address of your table
        Set rngHeader = .Range("A1:C1")

        For Each nm In names
            With rngHeader
                'Apply filter to "Name" column
                .AutoFilter Field:=1, Criteria1:=nm
                On Error Resume Next
                'get all visible rows 
                Set res = .Offset(2).Resize(lastrow - 1).SpecialCells(xlCellTypeVisible)
                On Error GoTo 0

                'if there is visible rows, create new WB
                If Not res Is Nothing Then
                    'create new workbook
                    Set wb = Workbooks.Add
                    'add sheet with name form column "Names" ("Paul", "Nick" or etc)
                    wb.Worksheets.Add.name = nm
                    'delete other sheets from new wb
                    For Each ws1 In wb.Worksheets
                        If ws1.name <> nm Then ws1.Delete
                    Next

                    'copy/paste data
                    With wb.Worksheets(nm)
                        'copy headers
                       rngHeader.Copy Destination:=.Range("A1")   
                        'copy data
                       res.Copy Destination:=.Range("A2")
                    End With

                    'save wb
                    wb.Close saveChanges:=True, Filename:=ThisWorkbook.Path & "\Spreadsheet_" & nm & ".xlsx"
                    Set wb = Nothing
                End If
            End With
        Next
        'disable all filters
        .AutoFilterMode = False
    End With

    Set names = Nothing

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Answer 1

VBScript被设计为可以进入VB / VBA。只要删除数据类型（使用默认的varient数据类型），它就会以其他方式工作。因为您在外部运行，所以需要连接到excel。

Set ws = ThisWorkbook.Worksheets("Sheet1")

变为

set excelapp=createobject("Excel.Application")

Set ws = excelapp.Workbooks.Open("C:\Users\David Candy\Documents\Payrates.xls").worksheets("Sheet1")

msgbox ws.name

Answer 2

应该是可以修复的。请记住，当您编写VBScript程序时，您不再在 Excel中。因此，Application和ThisWorkbook等全局对象不可用。您需要创建自己的对象来引用它们。例如：

Set Application = CreateObject("Excel.Application")
Set ThisWorkbook = Application.Workbooks.Open(strFilePath)

现在，您的VBA代码在示例中使用了相同的两个对象。同样，记住您在Excel外部运行时，Excel定义的任何常量也将不可用（xlUp，xlCellTypeVisible等）。但是，在WSF文件中使用VBScript时，可以从Excel类型库中“导入”这些常量。但是通常只需查找您需要的那些并将它们自己定义为const就更简单了。

除此之外，其余的只是知道VBScript 语言和VBA之间的区别。例如，您不要将变量声明为VBScript中的特定类型。此外，在VBScript中调用函数时，不能使用<param>:=<value>对。

如果你遵循这些建议，你的形状应该很好。

如何将VBA转换为VBScript？

2 个答案: