如何在不同的列上使用另一个自动过滤器循环过滤范围？ [英] How to cycle through a filtered range using another auto filter on a different column?

问题描述

根据条件（> 1），我有一个应用于F列的过滤器。 rng.AutoFilter字段：= 6，Criteria1：=> 1其中rng通过VBA为数据设置。

现在从已过滤的行我想在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 =现在
 fname = Application.GetOpenFilename（FileFilter：=Excel Files（* .xls; * .xlsx; *。xlsm），* .xls; *。xlsx; *。xlsm，标题：=选择术语更改查询结果文件）
如果fname = False则退出Sub 
 
 ans = MsgBox（Is& fname&术语更改查询结果excel文件？，vbYesNo）
 
如果ans = vbYes然后
 Workbooks.Open文件名：= fname 
 Else 
 MsgBox（请再次运行现金流量报告genrator并选择查询结果文件。）
退出子
 End If 
 
 Set Source = ActiveWorkbook 
 Set sh = ActiveSheet 
 
 sh.Range（E：F）。插入Shift：= xlToRight，CopyOrigin： = xlFormatFromLeftOrAbove 
范围（E1）Value =Number_Site
范围（F1）Value =Count Num_Site
 
范围（E2）。公式R1C1 == RC [-3]& RC [-1]
r = Range（A1）。End（xlDown）.Row 
 Range（E2，Cells（r， EF）。FillDown 
列（E：F）。AutoFit 
 
设置rng = Range（A1）
设置rng = Range（rng，rng。结束（xlToRight））
设置rng =范围（rng，rng.End（xlDown））
 rng.Name =数据
 
范围（A2，范围A2）。End（xlDown））Name =Date
范围（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 
 
带有sh。排序
 .SetRange Range（Data）
 .Header = xlYes 
 .MatchCase = False 
 .Orientation = xlTopToBottom 
 .SortMethod = xlPinYin 
。应用
 
 
范围（F2）。Formula == countif（$ E $ 2：$ E $ 1000，E2）
范围（F2，Cells（r，F ））。FillDown 
 
 rng.AutoFilter字段：= 6，Criteria1：=> 1
设置rng1 = rng.Rows.SpecialCells（xlCellTypeVisible）
 rng1。选择
  

我现在要根据字段5进行过滤，但是对于该字段内的每个唯一值通过它 - 在这种情况下只有2 - 可以更多）

这里是一个链接截图截图的数据，第一个过滤器应用于Col F，现在我想在这个过滤器中循环浏览Col E中的2个唯一值（在这种情况下）：

如果有一个比过滤器更优雅的解决方案，那么我是开放的 - 我已经尝试了枢轴和广告提升过滤器但无法找出解决方案。

提前感谢，所有的帮助不胜感激。

解决方案

虽然Scripting.Dictionary可能会使查找唯一的值更容易一些，但只需要几行额外的代码来复制字典的存在功能

  Dim rng As Range，ctv As Range，f As Long，vFLTR As Variant 
 
 vFLTR = ChrW（8203）
 
使用ActiveSheet设置此工作表参考正确！ 
如果.AutoFilterMode然后.AutoFilterMode = False 
设置rng = .Cells（1，1）.CurrentRegion 
 
带有rng 
 .AutoFilter字段：= 6，Criteria1 ：=> 1
如果Application.Subtotal（103，.Columns（5））> 1然后
与rng.Offset（1，0）.Resize（.Rows.Count  -  1，.Columns.Count）
对于每个ctv在.Columns（5）.Cells.SpecialCells（xlCellTypeVisible） 
如果不是CBool​​（InStr（1，vFLTR，ChrW（8203）& ctv.Value& ChrW（8203），vbTextCompare））然后
 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））
结束
对于f = LBound（vFLTR）到UBound（vFLTR）
 .AutoFilter字段：= 5，Criteria1：= vFLTR f）
 MsgBox暂停和看
 .AutoFilter字段：= 5 
下一个f 
如果
 .AutoFilter 
结束
结束与
  

我写道，等待你提供它所属的框架，但你可以肯定请参阅首先收集一组唯一的可见值的过程，然后循环使用它们以获取额外的过滤柱。

I have a filter applied on column F based on a criteria (>1) rng.AutoFilter Field:=6, Criteria1:=">1" where rng is set for the data via VBA earlier.

Now from the filtered rows I want to apply another filter on Col E (5) and cycle through each of the unique visible values in Col E and perform some comparisons on the data and determine whether to keep it or delete those rows- but I don't know what values would be shown - that depends on the first filter - how do I accomplish this?

Here is the whole code so far:

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

I would now want to filter based on field 5 but for each unique value within that field (cycle through it - in this case just 2 - could be more)

Here is a link to the screenshot screenshot of the data with the first filter applied on Col F, now I would like to cycle through the 2 unique values (in this case) in Col E based on this filter:

If there is a more elegant solution than filter then I am open to that - I have tried Pivots and advanced filters but could not figure out a solution.

Thanks in advance and all help is appreciated.

解决方案

While a Scripting.Dictionary may make locating unique values a bit easier, it only takes a couple lines of extra code to duplicate the dictionary's Exists functionality.

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

I wrote that while waiting for you to provide the framework that it belongs in but you can certainly see the process of first collecting a unique set of visible values then cycling through them for a additional filtered column.

这篇关于如何在不同的列上使用另一个自动过滤器循环过滤范围？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！