Excel VBA – 自动filter和高级filter使用错误

我有一个需求在哪里，我需要使用自动筛选器来筛选数据，然后使用高级筛选器来获取唯一值。 但高级filter不会单独使用自动过滤值。 我如何一起使用它们？

这里是我的代码，

Colmz = WorksheetFunction.Match("RSDate", Sheets("RS_Report").Rows(1), 0) ActiveSheet.ListObjects("RS").Range.AutoFilter Field:=Colmz, Criteria1:="YES" ActiveSheet.Range("B1:B65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("CSRS").Range("B14"), Unique:=True 

请纠正我，分享你的build议。 谢谢

Answer 1

我会坚持一个数组中的唯一值 – 这是更快，不太可能打破 –

 sub uniquearray() Colmz = WorksheetFunction.Match("RSDate", Sheets("RS_Report").Rows(1), 0) ActiveSheet.ListObjects("RS").Range.AutoFilter Field:=Colmz, Criteria1:="YES" Call creatary(curary, Sheets("RS_Report"), Letter(Sheets("RS_Report"), "RSDate")): Call eliminateDuplicate(curary): Call BuildArrayWithoutBlankstwo(curary): Call Alphabetically_SortArray(curary) For Each cell In curary 'do what you need to do with the unique array list Next cell end sub Function creatary(ary As Variant, sh As Worksheet, ltr As String) Dim x, y, rng As Range ReDim ary(0) Set rng = sh.Range(ltr & "2:" & ltr & sh.Range("A1000000").End(xlUp).Row).SpecialCells(xlCellTypeVisible) x = 0 For Each y In rng If Not Application.IsError(y) Then If Not IsNumeric(y) Then ary(x) = y End If x = x + 1 ReDim Preserve ary(x) End If Next y End Function Function BuildArrayWithoutBlankstwo(ary As Variant) Dim AryFromRange() As Variant, AryNoBlanks() As Variant Dim Counter As Long, NoBlankSize As Long 'set references and initialize up-front ReDim AryNoBlanks(0 To 0) NoBlankSize = 0 'load the range into array AryFromRange = ary 'loop through the array from the range, adding 'to the no-blank array as we go For Counter = LBound(AryFromRange) To UBound(AryFromRange) If ary(Counter) <> 0 Then NoBlankSize = NoBlankSize + 1 AryNoBlanks(UBound(AryNoBlanks)) = ary(Counter) ReDim Preserve AryNoBlanks(0 To UBound(AryNoBlanks) + 1) End If Next Counter 'remove that pesky empty array field at the end If UBound(AryNoBlanks) > 0 Then ReDim Preserve AryNoBlanks(0 To UBound(AryNoBlanks) - 1) End If 'debug for reference ary = AryNoBlanks End Function Function eliminateDuplicate(ary As Variant) As Variant Dim aryNoDup(), dupArrIndex, i, dupBool, j dupArrIndex = -1 For i = LBound(ary) To UBound(ary) dupBool = False For j = LBound(ary) To i If ary(i) = ary(j) And Not i = j Then dupBool = True End If Next j If dupBool = False Then dupArrIndex = dupArrIndex + 1 ReDim Preserve aryNoDup(dupArrIndex) aryNoDup(dupArrIndex) = ary(i) End If Next i ary = aryNoDup End Function Function Alphabetically_SortArray(ary) Dim myArray As Variant Dim x As Long, y As Long Dim TempTxt1 As String Dim TempTxt2 As String myArray = ary 'Alphabetize Sheet Names in Array List For x = LBound(myArray) To UBound(myArray) For y = x To UBound(myArray) If UCase(myArray(y)) < UCase(myArray(x)) Then TempTxt1 = myArray(x) TempTxt2 = myArray(y) myArray(x) = TempTxt2 myArray(y) = TempTxt1 End If Next y Next x ary = myArray End Function Function Letter(oSheet As Worksheet, name As String, Optional num As Integer) If num = 0 Then num = 1 Letter = Application.Match(name, oSheet.Rows(num), 0) Letter = Split(Cells(, Letter).Address, "$")(1) End Function