我正在尝试查看是否可以以编程方式捕获AutoFilter排序事件,获取排序条件,然后将相同的排序条件应用于第二个工作表中的AutoFilter。
到目前为止,我似乎必须触发Worksheet_Calculate()事件。我已经完成了。然后我必须检查AutoFilter排序标准是否已更改。如果不是,退出sub。如果是,请收集条件并通过单独的子程序运行它,该子程序在单独的工作表中对AutoFilter执行完全相同的排序。
一般的想法是,无论何时对这两个AutoFilter中的一个进行排序,另一个工作表中的AutoFilter应该以完全相同的方式排序。
我尝试过这样的事情(我必须添加Excel公式来实际计算事件触发器):
Private Sub Worksheet_Calculate()
Dim wbBook as Workbook
Dim wsSheet as Worksheet
Dim rnData as Range
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Sheet1")
With wsSheet
Set dnData = .UsedRange
End With
End Sub
但我似乎无法收集标准,我尝试了几件事,并且向dnData添加手表甚至没有显示任何AutoFilter属性。有人可以对此有所了解吗?
答案 0 :(得分:2)
以下是获取autofilter
条件的方法:
Sub test()
Dim Header As Range
Dim sMainCrit As String, sANDCrit As String, sORCrit As String
Set Header = Range("A2:C2")
With Header.Parent.AutoFilter
With .Filters(Header.Column - .Range.Column + 1)
If Not .On Then
MsgBox ("no criteria")
Exit Sub
End If
sMainCrit = .Criteria1
If .Operator = xlAnd Then
sANDCrit = .Criteria2
ElseIf .Operator = xlOr Then
sORCrit = .Criteria2
End If
End With
End With
MsgBox ("Main criteria: " & sMainCrit & Chr(13) & "AND Criteria:" & sANDCrit & Chr(13) & "OR Criteria" & sORCrit)
End Sub
改编自ozgrid
答案 1 :(得分:1)
以下是我认为您的要求的一些注释。
Dim rv As AutoFilter ''Object
Set rv = Sheet1.AutoFilter
''Just for curiosity
Debug.Print rv.Sort.Header
Debug.Print rv.Sort.SortFields.Count
Debug.Print rv.Sort.SortFields.Item(1).SortOn
Debug.Print rv.Sort.Rng.Address
Debug.Print rv.Sort.SortFields.Item(1).Key.Address
''One key only, but it is easy enough to loop and add others
Sheet2.Range(rv.Sort.Rng.Address).Sort _
key1:=Sheet2.Columns(rv.Sort.SortFields(1).Key.Column), _
Header:=xlYes
答案 2 :(得分:0)
找到此代码:
Sub ShowAutoFilterCriteria()
' John Green et. al: Excel 2000 VBA Programmer?s Reference, S. 379f
' 09.01.2005
Dim oAF As AutoFilter
Dim oFlt As Filter
Dim sField As String
Dim sCrit1 As String
Dim sCrit2 As String
Dim sMsg As String
Dim i As Integer
' Check if the sheet is filtered at all
If ActiveSheet.AutoFilterMode = False Then
MsgBox "The sheet does not have an Autofilter"
Exit Sub
End If
' Get the sheet?s Autofilter object
Set oAF = ActiveSheet.AutoFilter
' Loop through the Filters of the Autofilter
For i = 1 To oAF.Filters.Count
' Get the field name form the first row
' of the Autofilter range
sField = oAF.Range.Cells(1, i).Value
' Get the Filter object
Set oFlt = oAF.Filters(i)
' If it is on...
If oFlt.On Then
' Get the standard filter criteria
sMsg = sMsg & vbCrLf & sField & oFlt.Criteria1
' If it?s a special filter, show it
Select Case oFlt.Operator
Case xlAnd
sMsg = sMsg & " And " & sField & oFlt.Criteria2
Case xlOr
sMsg = sMsg & " Or " & sField & oFlt.Criteria2
Case xlBottom10Items
sMsg = sMsg & " (bottom 10 items)"
Case xlBottom10Percent
sMsg = sMsg & " (bottom 10%)"
Case xlTop10Items
sMsg = sMsg & " (top 10 items)"
Case xlTop10Percent
sMsg = sMsg & " (top 10%)"
End Select
End If
Next i
If msg = "" Then
' No filters are applied, so say so
sMsg = "The range " & oAF.Range.Address & " is not filtered."
Else
' Filters are applied, so show them
sMsg = "The range " & oAF.Range.Address & " is filtered by:" & sMsg
End If
' Display the message
MsgBox sMsg
End Sub
我的测试工作正常!我改变了一小部分内容以支持复杂的标准:
' Get the standard filter criteria
If IsArray(oFlt.Criteria1) Then
Dim x As Integer
sMsg = sMsg & vbCrLf & sField
For x = 1 To UBound(oFlt.Criteria1)
sMsg = sMsg & "'" & oFlt.Criteria1(x) & "'"
Next x
Else
sMsg = sMsg & vbCrLf & sField & "'" & oFlt.Criteria1 & "'"
End If
原始链接:http://www.vbaexpress.com/forum/archive/index.php/t-7564.html