vba 获取自动筛选排序条件并应用于第二张纸
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/7764655/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Get AutoFilter sort criteria and apply on second sheet
提问by Kenny Bones
I'm trying to see if I can programatically trap an AutoFilter sort event, get the sort criteria and then apply that same sort criteria to an AutoFilter in a second worksheet.
我正在尝试查看是否可以以编程方式捕获自动筛选排序事件，获取排序条件，然后将相同的排序条件应用于第二个工作表中的自动筛选。
So far it seems as though I have to trigger the Worksheet_Calculate() event. And this I've done. Then I have to check if the AutoFilter sort criteria was changed. If it wasn't, exit sub. If it was, collect the criteria and run it through a separate sub, which does the exact same sorting on an AutoFilter in a separate worksheet.
到目前为止，似乎我必须触发 Worksheet_Calculate() 事件。而这我已经做到了。然后我必须检查自动筛选排序标准是否已更改。如果不是，请退出 sub。如果是，请收集条件并通过单独的子程序运行它，该子程序在单独的工作表中对自动筛选器执行完全相同的排序。
The general idea is that whenever one of these two AutoFilters are sorted, the AutoFilter in the other sheet should be sorted the exact same way.
一般的想法是，无论何时对这两个自动筛选器中的一个进行排序，另一个工作表中的自动筛选器都应以完全相同的方式进行排序。
I've tried to do something like this (I had to add an Excel formula to actually make the calculate event trigger):
我试图做这样的事情（我不得不添加一个 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
But I can't seem to manage to collect the criteria, I've tried several things and adding a watch to the dnData doesn't even reveal any AutoFilter property. Can someone shed any light on this?
但我似乎无法设法收集标准，我尝试了几件事，向 dnData 添加手表甚至没有显示任何 AutoFilter 属性。有人可以对此有所了解吗？
回答by JMax
Here is a way to get the autofiltercriteria:
这是获取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
Adapted from ozgrid
改编自ozgrid
回答by Fionnuala
Here are some notes on what I see as your requirements.
以下是我认为您的要求的一些说明。
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
回答by Tomamais
Found this code:
找到这个代码：
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
Works fine on my tests! I've changed a small part of it to support complex criteria:
在我的测试中运行良好！我已经更改了其中的一小部分以支持复杂的标准：
' 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
Original link: http://www.vbaexpress.com/forum/archive/index.php/t-7564.html
原文链接：http: //www.vbaexpress.com/forum/archive/index.php/t-7564.html
