Question

我根据条件（＆gt; 1）rng.AutoFilter Field:=6, Criteria1:=">1"在F列上应用了过滤器，其中通过VBA为数据设置了rng。

现在，从过滤后的行中，我想在Col E（5）上应用另一个过滤器，并循环浏览Col E中的每个唯一可见值，并对数据执行一些比较，并确定是保留还是删除这些行 - 但我不知道会显示哪些值 - 这取决于第一个过滤器 - 我该如何实现？

到目前为止，这是完整的代码：

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 - 可能更多）

以下是第一个过滤器应用于Col F的数据截图屏幕截图的链接，现在我想基于此过滤器在Col E中循环显示2个唯一值（在本例中）：

data

如果有一个比过滤器更优雅的解决方案，那么我对此持开放态度 - 我尝试了Pivots和高级过滤器，但无法找到解决方案。

提前致谢，感谢所有帮助。

Answer 1

虽然Scripting.Dictionary可以使定位唯一值更容易，但只需要几行额外的代码来复制字典的Exists功能。

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

我在等待您提供它所属的框架时写道，但您当然可以看到首先收集一组唯一可见值然后在其中循环使用其他过滤列的过程。

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

1 个答案: