如何循环使用另一列上的另一个自动filter的过滤范围?

我有一个filter应用在F列的基础上(> 1) rng.AutoFilter Field:=6, Criteria1:=">1"其中rng是通过早期的VBA为数据设置的。

现在,从过滤的行中,我想对Col E(5)应用另一个filter,然后遍历Col E中的每个唯一可见值,并对数据执行一些比较,并确定是保留还是删除这些行 – 但我不不知道将显示什么值 – 这取决于第一个filter – 我该如何做到这一点?

这是迄今为止的整个代码:

 Sub CashFlowReporting() Dim Dest, Source As Workbook Dim DestCell As Range Dim sh, ws, data As Worksheet Dim x, y, r, c, m, s As Integer Dim fname, sname, txt As String Dim starttime, endtime, dtDate As Date Dim ans As VbMsgBoxResult Dim rng, rng1 As Range Application.ScreenUpdating = False Application.DisplayAlerts = False starttime = Now fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm", Title:="Select the Term Changes Query Results file.") If fname = False Then Exit Sub ans = MsgBox("Is " & fname & "the Term Changes Query Results excel file?", vbYesNo) If ans = vbYes Then Workbooks.Open Filename:=fname Else MsgBox ("Please run the cash flow report genrator again and select the query results file.") Exit Sub End If Set Source = ActiveWorkbook Set sh = ActiveSheet sh.Range("E:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("E1").Value = "Number_Site" Range("F1").Value = "Count Num_Site" Range("E2").FormulaR1C1 = "=RC[-3]&RC[-1]" r = Range("A1").End(xlDown).Row Range("E2", Cells(r, "E")).FillDown Columns("E:F").AutoFit Set rng = Range("A1") Set rng = Range(rng, rng.End(xlToRight)) Set rng = Range(rng, rng.End(xlDown)) rng.Name = "Data" Range("A2", Range("A2").End(xlDown)).Name = "Date" Range("E2", Range("E2").End(xlDown)).Name = "Num_site" sh.Sort.SortFields.Clear sh.Sort.SortFields.Add Key:=Range("Num_site") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal sh.Sort.SortFields.Add Key:=Range("Date") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With sh.Sort .SetRange Range("Data") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("F2").Formula = "=countif($E$2:$E$1000,E2)" Range("F2", Cells(r, "F")).FillDown rng.AutoFilter field:=6, Criteria1:=">1" Set rng1 = rng.Rows.SpecialCells(xlCellTypeVisible) rng1.Select 

我现在想要根据字段5进行过滤,但对于该字段中的每个唯一值(循环访问 – 在这种情况下只有2个 – 可能更多)

这里是第一个filter应用在Col F上的截图数据截图的链接,现在我想通过Col E中的2个唯一值(在这种情况下)基于这个filter:

数据

如果有一个比过滤更优雅的解决scheme,那么我打开这一点 – 我已经尝试枢轴和先进的filter,但无法找出解决scheme。

在此先感谢和所有帮助表示赞赏。

虽然Scripting.Dictionary可能使定位唯一值更简单一些,但它只需要几行额外的代码来复制字典的Existsfunction。

 Dim rng As Range, ctv As Range, f As Long, vFLTR As Variant vFLTR = ChrW(8203) With ActiveSheet 'set this worksheet reference properly! If .AutoFilterMode Then .AutoFilterMode = False Set rng = .Cells(1, 1).CurrentRegion With rng .AutoFilter Field:=6, Criteria1:=">1" If Application.Subtotal(103, .Columns(5)) > 1 Then With rng.Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) For Each ctv In .Columns(5).Cells.SpecialCells(xlCellTypeVisible) If Not CBool(InStr(1, vFLTR, ChrW(8203) & ctv.Value & ChrW(8203), vbTextCompare)) Then vFLTR = vFLTR & ctv.Value & ChrW(8203) End If Next ctv vFLTR = Left(vFLTR, Len(vFLTR) - 1): vFLTR = Right(vFLTR, Len(vFLTR) - 1) vFLTR = Split(vFLTR, ChrW(8203)) End With For f = LBound(vFLTR) To UBound(vFLTR) .AutoFilter Field:=5, Criteria1:=vFLTR(f) MsgBox "pause and look" .AutoFilter Field:=5 Next f End If .AutoFilter End With End With 

我在等待你提供它所属的框架的同时写道,但是你当然可以看到首先收集一系列可见值的过程,然后循环遍历一个额外的过滤列。