正确使用 Application.Run

Question

我不确定我是否完全理解 Application.Run 的用法。我曾尝试在我的一个宏中使用它，但没有看到预期的变化。这是设置。我有一个 Excel 插件，其中运行有几个来自菜单系统的宏。其中一个宏会将数据从提取工作簿复制到主工作簿。前几天，其中一位用户对其中一列应用了过滤器，但在运行复制代码之前没有清除它。这导致数据无法正确复制。因此，我研究了如何运行来自提取工作簿的主工作簿上的代码以在 copy/paste 发生之前清除过滤器。

为了更好地阐明我需要它如何工作：

工作簿 A 包含需要移动到 工作簿 B
工作簿 A 将对数据进行排序并删除不需要的数据 工作簿 B.
在工作簿 B 中，如果过滤器是在打开和关闭工作簿时应用。
在将数据从 工作簿 A 复制并粘贴到 工作簿 B 之前，我需要 workbook A 触发 workbook B 中的 unfilter 代码以执行 workbook B 中的子程序。

这是提取工作簿（工作簿 A）（使用加载项）中的代码：

Sub Extract_Sort_1601_January()

Dim ANS As Long

ANS = MsgBox("Is the January 2016 Swivel Master File checked out of SharePoint and currently open on this desktop?", vbYesNo + vbQuestion + vbDefaultButton1, "Master File Open")
If ANS = vbNo Or IsWBOpen("Swivel - Master - January 2016") = False Then
    MsgBox "The required workbook is not currently open. This procedure will now terminate.", vbOKOnly + vbExclamation, "Terminate Procedure"
    Exit Sub
End If

Application.ScreenUpdating = False

    ' This line autofits the columns C, D, O, and P
    Range("C:C,D:D,O:O,P:P").Columns.AutoFit

    ' This unhides any hidden rows
    Cells.EntireRow.Hidden = False

Dim LR As Long

    For LR = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
        If Range("B" & LR).Value <> "1" Then
            Rows(LR).EntireRow.Delete
        End If
    Next LR

Application.Run "'Swivel - Master - January 2016.xlsm'!Unfilter"

With ActiveWorkbook.Worksheets("Extract").Sort
    With .SortFields
        .Clear
        .Add Key:=Range("B2:B2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("D2:D2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("O2:O2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("J2:J2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("K2:K2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("L2:L2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    End With
    .SetRange Range("A2:AE2000")
    .Apply
End With
Cells.WrapText = False
Sheets("Extract").Range("A2").Select

    Dim LastRow As Integer, i As Integer, erow As Integer

    'With Workbooks("Swivel - Master - January 2016.xlsm").Sheets("Swivel")
        'erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        '.Range("A2:AE" & erow).AutoFilter 'leaving arguments blank clears all filters, but leaves the drop-down arrows (filter mode still on)
    'End With

    LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To LastRow
        If Cells(i, 2) = "1" Then

            ' As opposed to selecting the cells, this will copy them directly
            Range(Cells(i, 1), Cells(i, 31)).Copy

            ' As opposed to "Activating" the workbook, and selecting the sheet, this will paste the cells directly
            With Workbooks("Swivel - Master - January 2016.xlsm").Sheets("Swivel")
                erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                .Cells(erow, 1).PasteSpecial xlPasteAll
            End With
            Application.CutCopyMode = False
        End If
    Next i

Application.ScreenUpdating = True
End Sub

这是我需要在主工作簿（工作簿 B）上运行的 Unfilter 代码（它位于主工作簿的一个模块中）：

Sub Unfilter()

    Dim she As Variant
    For Each she In Worksheets
         If she.FilterMode Then she.ShowAllData
    Next
End Sub

我是否正确使用了 Application.Run？或者我的代码还有其他问题吗？我没有收到任何错误。当我对此进行测试时，工作簿 B 中的数据保持过滤状态。

Answer 1

更改 Unfilter sub 以直接使用代码所在的工作簿。

见下文：

Sub Unfilter()

    Dim she As Variant
    For Each she In ThisWorkbook.Worksheets
         If she.FilterMode Then she.ShowAllData
    Next
End Sub

正确使用 Application.Run

Proper use of Application.Run

excel

vba

excel-2007