Question

我一直在想如何做到这一点并且无法弄明白。前提如下。我需要过滤 COLUMN B ，然后我需要使用 COLUMN A 的过滤返回结果来过滤所有结果。如果那令人困惑，我试图在下面“画出”......

@b3.form(routes.Controller.saveSomething) {
    @b3.hidden( "id", form("id").value, 'attr -> false
    @b3.text( form("name"), '_label -> "Title", 'placeholder -> "Enter Something name here" )
    @b3.text( form("description"), '_label -> "Description", 'placeholder -> "Enter short description here" )
    @b3.submit('class -> "btn btn-default"){ <span class="glyphicon glyphicon-ok"></span> Save }
    @flash.get("success") 
}

因此，如果我在B列上过滤44，我只会返回两个'44'行（cat | 44和bird | 44）。相反，我想以某种方式得到所有猫行和所有鸟行，因为44与这两个'A'类型相关联。

COL A | COL B |
cat   | 44    |
cat   | 476   |
cat   | 19    |
dog   | 11    |
dog   | 12    |
bird  | 44    |
bird  | 99    |
bird  | 4556  |

你们之前有没有这样做过？我的想法最初是将未经改动的纸张复制到新纸张2，应用过滤器并将返回的列A结果复制到新纸张3，使用返回的列A导致纸张3在sheet2列A上执行自动过滤但是，可能有数百个过滤器，这在VBA中是一个非常手动的过程。

如果需要，我很乐意添加更多细节。

Answer 1

您可以将此例程作为模型：它适用于Sheet1，在44列中查找B，然后显示与列A匹配的行

Sub filterBthenA()
    Sheet1.UsedRange.Columns("B").AutoFilter 1, 44 '<-- Filter Sheet1 col B by value 44
    Dim cel As Range, dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    For Each cel In Sheet1.UsedRange.Columns("A").SpecialCells(xlCellTypeVisible)
        dict(cel.Value) = 0
    Next
    Sheet1.AutoFilterMode = False
    Sheet1.UsedRange.Columns("A").AutoFilter 1, dict.Keys, xlFilterValues
End Sub

Answer 2

您可以避免使用一个或多个变体数组AutoFilter method和Range.SpecialCells method。

Option Explicit

Sub cats_and_birds()
    Dim crit As Long
    Dim i As Long, j As Long, iCols As Long
    Dim arr1 As Variant
    Static dict As Object  '<~~ faster second time around this way

    'create and configure the static dictionary
    If dict Is Nothing Then _
        Set dict = CreateObject("Scripting.Dictionary")
    dict.RemoveAll
    dict.CompareMode = vbTextCompare

    'number of columns to transfer from column A
    iCols = 3
    'set filter criteria for column 2 within range
    crit = 44

    With Worksheets("Sheet1")

        'assign raw values
        arr1 = .Range(.Cells(2, 1), Cells(.Rows.Count, iCols).End(xlUp)).Value2

        'show the data array limits in the Immediate window
        'delete this or comment it after the routine works
        Debug.Print LBound(arr1, 1) & " to " & UBound(arr1, 1)
        Debug.Print LBound(arr1, 2) & " to " & UBound(arr1, 2)

        'iterate through the 'rows' of the array and compare column 2
        For i = LBound(arr1, 1) To UBound(arr1, 1)
            'add/oversrite the pet species as key
            If arr1(i, 2) = crit Then _
                dict(arr1(i, 1)) = 0

            'if pet species in key, transfer information
            If dict.exists(arr1(i, 1)) Then
                'iterate through the columns backwards to maintain row
                For j = UBound(arr1, 2) To LBound(arr1, 2) Step -1
                    .Cells(.Rows.Count, "Z").End(xlUp).Offset(1, j - 1) = arr1(i, j)
                Next j
            End If
        Next i

    End With

End Sub

两个阵列实际上会更好;第二个接收结果，然后批量传输信息，但由于使用保留（和转置）重新排列数组，也会有（较小的）惩罚。对于小（<10K），这可能只是稍微长一点处理。对于＆lt; 100行过滤后的信息，如果没有特殊工具，您可能无法衡量差异。

将字典对象调暗为静态第二次缩短加载时间因为您不必重新创建对象。虽然我更喜欢将 Microsoft Scripting Runtime 添加到工具►参考并使用dim dict as new scripting.dictionary，但并不是每个人都喜欢这样，所以我将这个用CreateObject和dim dict发布为静态。

过滤一列，返回不同列的所有相关结果

2 个答案: