Question

我不确定我是否完全理解Application.Run的使用。我试过在我的一个宏中使用它，但我没有看到预期的变化。这是设置。我有一个Excel加载项，它从菜单系统运行几个宏。其中一个宏将数据从提取工作簿复制到主工作簿。前几天，其中一个用户已将过滤器应用于其中一个列，并且在运行复制代码之前未将其清除。这导致数据无法正确复制。所以我研究了如何在提取工作簿中运行主工作簿上的代码，以便在复制/粘贴之前清除过滤器。

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

工作簿A 包含需要移至工作簿B 的数据
工作簿A 将对数据进行排序并删除不需要的数据 练习册B 。
在工作簿B 中，我有代码，如果有过滤器，则会显示所有数据适用于工作簿的打开和关闭。
在将数据从工作簿A 复制并粘贴到工作簿B 之前，我需要工作簿A 触发工作簿B 中的未过滤代码才能执行工作簿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

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

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 Unfilter()

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

正确使用Application.Run

1 个答案: