时间戳

首页 > 解决方案 > 如何使用另一个文件中的代码从文件中删除所有过滤器？

excel - 如何使用另一个文件中的代码从文件中删除所有过滤器？

问题描述

我正在尝试从文件中删除所有过滤器TestA.xlsx。

有时过滤器在TestA.xlsx. 如果您TestB之后打开，并非所有数据都被复制到 file TestB。

因此，它的工作原理是，如果“文件 A”打开并且您打开“文件 B”，“文件 B”会检查“文件 A”是否处于活动状态。如果它处于活动状态，它会将工作表 TestA 中的“文件 A”中的所有内容复制到工作表中的“文件 B” TestB。

Private Sub Workbook_Open()

    Dim WB As Workbook
    On Error Resume Next
    Set WB = Workbooks("Test.xlsx")
    If Err Then
        MsgBox "Test" & vbNewLine & "" & vbNewLine & "" & "Test" & vbNewLine & "" & vbNewLine & "Test" & vbNewLine & "" & vbNewLine & "Test"
        'ThisWorkbook.Close
    End If

    Workbooks("TestA.xlsx").Worksheets("TestA").ShowAllData
    Workbooks("TestA.xlsx").Worksheets("TestA").Range("A2:AF666").Copy _
    Workbooks("TestB.xlsm").Worksheets("TestB").Range("A2")
    Worksheets("TestC").Range("A1").AutoFilter Field:=1, Criteria1:="JA"
    Workbooks("TestB.xlsm").Worksheets("TestB").Range("B2:AF666").Copy _
    Workbooks("TestB.xlsm").Worksheets("TestC").Range("B2")

    On Error GoTo 0

End Sub

标签： excelvba

解决方案

删除过滤器

Option Explicit

Private Sub Workbook_Open()
    
    Const swbName As String = "TestA.xlsx"
    Const sName As String = "TestA"
    Const dName As String = "TestB"
    Const d2Name As String = "TestC"
    
    If Not isWorkbookOpen(sName) Then
        MsgBox "The workbook '" & sName & "' is not open."
        Exit Sub
    End If
    
    Dim sws As Worksheet: Set sws = Workbooks(swbName).Worksheets(sName)
    Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets(dName)
    Dim dws2 As Worksheet: Set dws2 = ThisWorkbook.Worksheets(d2Name)
    
    If sws.AutoFilterMode Then
        sws.AutoFilterMode = False
    End If
    sws.Range("A2:AF666").Copy dws.Range("A2")
    
    dws2.Range("A1").AutoFilter Field:=1, Criteria1:="JA"
    ' This makes no sense, you cannot copy to a non-contiguous range.
    'dws.Range("B2:AF666").Copy dw2.Range("B2")
 
End Sub

Function isWorkbookOpen( _
    ByVal FileName As String) _
As Boolean
    On Error Resume Next
    Dim wb As Workbook: Set ws = Workbooks(FileName)
    On Error GoTo 0
    isWorkbookOpen = Not wb Is Nothing
End Function

推荐阅读