慢速搜索/过滤算法

Question

我的问题是，我当前的代码现在非常慢，我想使其更快，但是不知道如何。

我有成行的数据集，看起来像这样：

我需要过滤/搜索那些值，例如数字（例如，显示所有> 30）。但是某些条目，例如30|32,89不是数字。现在，我正在检查每个值（如果需要拆分），例如30|32,89和30中的32,89，并将所有值写在工作表中。所以我有一列，其中所有值都是数字。第二列保存原始行号，如下所示：

之后，我使用高级过滤器来获取所需的数据。我将其写在另一列中。如果该单元格中的多个数字满足搜索条件，则使用原始行号仅写入来自同一原始单元格的值。为此，我将所有原始数据（20列和许多行）保存在2D数组中。然后我仅从该数组中获取值，其中第一个索引与过滤后的数据的原始行数匹配，并为每个第一个索引将所有值写在另一张表中，每个行都买入（这部分导致了大部分缓慢）。每个第一个索引有20个值。因此，最后我获得了一张表中显示的过滤项目的所有相应数据。

这是我的代码：

Public Sub numberSearch(srchCol As String, srchValue As String)
    Dim sValues As Variant, wRange As Variant

    'temp values
    cRow = archSh.Range("A1").CurrentRegion.rowS.count
    Dim srchCol As String
    srchCol = "B"
    Dim srchValue As String
    srchValue = ">2005"
    '------------------

    'prepare sheet
    shSearch.Cells.Clear
    sValues = Application.Transpose(archSh.Range(srchCol & "2", srchCol & cRow))
    wRange = archSh.Range("A1").CurrentRegion
    shSearch.Range("A1").Value = archSh.Range(srchCol & "1").Value
    shSearch.Range("B1").Value = "tst"
    shSearch.Range("D1").Value = shSearch.Range("A1").Value
    shSearch.Range("E1").Value = shSearch.Range("B1").Value
    shSearch.Range("G1").Value = shSearch.Range("A1").Value
    shSearch.Range("H1").Value = shSearch.Range("B1").Value
    shSearch.Range("D2").Value = srchValue
    '----------------------------
    'spilt values, make all numeric
    Dim i As Long, j As Long, k As Long
    Dim tst As Variant, c As Variant
    Dim s
    i = 2
    k = 2
    For Each c In sValues
        If IsNumeric(c) = True Then
            ReDim tst(0 To 0)
            tst(0) = c
        Else
            tst = Split(c, sepa)
        End If
        For j = 0 To UBound(tst)
            shSearch.Range("A" & k + j).Value = tst(j)
            shSearch.Range("B" & k + j).Value = i
        Next j
        i = i + 1
        k = k + UBound(tst) - LBound(tst) + 1
    Next
    '--------------------------------
    'filter data
    Dim rgData As Range, rgCrit As Range, rgOut As Range
    Set rgData = shSearch.Range("A1").CurrentRegion
    Set rgCrit = shSearch.Range("D1").CurrentRegion
    Set rgOut = shSearch.Range("G1").CurrentRegion
    rgData.AdvancedFilter xlFilterCopy, rgCrit, rgOut
    '---------------------------------
    'write searched data
    Dim searchColVal As Variant
    searchColVal = Application.Transpose(shSearch.Range("H1:H" & shSearch.Cells(rowS.count, 8).End(xlUp).row))
    Dim tempItem As Long
    tempItem = 0
    k = 4
    tmpSh.Range("A4").CurrentRegion.Clear
    archSh.Range("A1:T1").Copy tmpSh.Range("A4")
    For i = 2 To UBound(searchColVal)
        If tempItem <> searchColVal(i) Then
            ReDim Preserve filterRow(1 To k - 3)
            filterRow(k - 3) = searchColVal(i)
            k = k + 1
            tempItem = searchColVal(i)
            For j = 1 To UBound(wRange, 2)
                tmpSh.Cells(k, j).Value = wRange(searchColVal(i), j)
            Next j
        End If
    Next i
    '----------------------------------------
End Sub

有人可以帮助我加快混乱的速度吗？提前输入。

Answer 1

这将向下扫描该列，将单元格值拆分为一个数组，然后使用Evaluate来应用搜索值。

Public Sub numberSearch2()

    Const COL_FILTER = "B"
    Const srchValue = ">2005"

    Dim wb As Workbook, wsSource As Worksheet, WsTarget, t0 As Single
    Dim iRow As Long, iLastRow As Long, iTargetRow As Long
    Dim ar As Variant, i As Integer
    t0 = timer

    Set wb = ThisWorkbook
    Set wsSource = wb.Sheets("Sheet2")
    Set WsTarget = wb.Sheets("Sheet3")
    WsTarget.Cells.Clear
    wsSource.Rows(1).EntireRow.Copy WsTarget.Range("A1")
    iTargetRow = 2

    With wsSource
        iLastRow = .Range(COL_FILTER & Rows.Count).End(xlUp).Row
        For iRow = 2 To iLastRow
            ar = Split(.Cells(iRow, COL_FILTER), "|")
            For i = 0 To UBound(ar)
                If Evaluate(ar(i) & srchValue) Then
                    wsSource.Rows(iRow).EntireRow.Copy WsTarget.Cells(iTargetRow, 1)
                    iTargetRow = iTargetRow + 1
                    i = UBound(ar) ' exit loop
                End If
            Next
        Next
    End With

    MsgBox iLastRow - 1 & " rows read " & vbCr & _
           iTargetRow - 2 & " rows written", vbInformation, "Completed in " & Int(timer - t0) & " secs"

End Sub

Answer 2

您可以使用Advanced Filter和公式标准来执行此操作。

我们使用FILTERXML （在Excel 2013+中可用）拆分文本值。我们也是ISNUMBER函数，通过在第一个公式中进行比较，排除了将文本值转换为TRUE的情况。

高级过滤器可以选择将结果写入其他位置

对于您的示例，两个公式可能是：

=AND(ISNUMBER(A9),A9>30)
=OR(FILTERXML("<t><s>" & SUBSTITUTE(A9,"|","</s><s>") & "</s></t>","//s")>30)

过滤前

过滤后

或者，如果您将两个公式的标准从>30更改为<30

根据需要，您当然可以使用VBA生成相关公式。