Question

我正在使用目前有3张的工作簿。第一张表是概述，其中将显示过滤后的数据。单元格D11具有我正在寻找的颜色。输入颜色单元格F3:I27填充颜色，形状，数字和动物等信息。

我会使用数据透视表，但是，我在K3:M27中有另一组数据。此数据是从具有类似功能的工作簿中的另一个工作表中提取的。

我使用的公式是：

=IFERROR(INDEX(cases!A:A,SMALL(IF(EXACT($D$3,cases!$C:$C),ROW(cases!$C:$C)-ROW($F$1)+1),ROW(1:1))),"")

当然，使用 CTRL + SHIFT + ENTER 输入它才能正常工作。

我尝试使用我从以下视频中提取的VBA宏：

Excel VBA Loop to Find Records Matching Search Criteria

Answer 1

如此多的数组公式可以让你的工作簿变得非常慢。

以下是使用数组填充Dataset1的代码。 它运行不到一秒。

希望这能让你开始。我已对代码进行了评论，但如果您仍然有理解问题，请回帖：）

Sub Sample()
    Dim DSOne() As String
    Dim tmpAr As Variant

    Dim wsCas As Worksheet: Set wsCas = ThisWorkbook.Sheets("Cases")
    Dim wsMain As Worksheet: Set wsMain = ThisWorkbook.Sheets("Sheet1")

    Dim lRow As Long, i As Long, j As Long

    '~~> Check if user entered a color
    If wsMain.Range("D3").Value = "" Then
        MsgBox "Please enter a color first", vbCritical, "Missing Color"
        Exit Sub
    End If

    '~~> Clear data for input in main sheet
    wsMain.Range("F3:F" & wsMain.Rows.Count).ClearContents

    '~~> Get last row of Sheet Cases
    lRow = wsCas.Range("A" & wsCas.Rows.Count).End(xlUp).Row

    With wsCas
        '~~> Get count of cells which have that color
        i = Application.WorksheetFunction.CountIf(.Columns(3), wsMain.Range("D3").Value)

        '~~> Check if there is any color
        If i > 0 Then
            '~~> Define your array to hold those values
            ReDim DSOne(1 To i, 1 To 4)
            '~~> Store the Sheet Cases data in the array
            tmpAr = .Range("A1:D" & lRow).Value

            j = 1

            '~~> Loop through the array to find the matches
            For i = LBound(tmpAr) To UBound(tmpAr)
                If tmpAr(i, 3) = wsMain.Range("D3").Value Then
                    DSOne(j, 1) = tmpAr(i, 1)
                    DSOne(j, 2) = tmpAr(i, 2)
                    DSOne(j, 3) = tmpAr(i, 3)
                    DSOne(j, 4) = tmpAr(i, 4)
                    j = j + 1
                End If
            Next i

            '~~> write to the main sheet in 1 Go!
            wsMain.Range("F3").Resize(UBound(DSOne), 4).Value = DSOne
        End If
    End With
End Sub

<强>截图：

enter image description here 使用上述方法现在填充Dataset2：）

更快速地根据特定值过滤数据

1 个答案: