Question

我循环遍历数据中的每个单元格以查看它是否与特定字符串匹配。如果匹配，则它将终止循环并要求最终用户查看数据。问题是，如果我有大量数据，这仍然需要太长时间。有没有办法提高速度？谢谢！

  Dim Keywords As Variant
    Dim SearchRange As Range
    Dim iRange_Col As Integer
    Dim lRange_Row As Long
    Dim vArray As Variant
    Dim lCnt As Long
    Dim lRowCnt As Long
    Dim keyw As Variant
    Dim val As String
    Dim found As Boolean

    Keywords = Array(Chr(34), "'", ",")
    lastrow2 = ThisWorkbook.Worksheets("Data").Range("A" & Rows.Count).End(xlUp).Row
    Set SearchRange = ThisWorkbook.Sheets("Data").Range("A1:BK" & lastrow2)
    iRange_Col = SearchRange.Columns.Count
    iRange_Row = SearchRange.Rows.Count
    ReDim vArray(1 To iRange_Row, 1 To iRange_Col)
    vArray = SearchRange

    For lRowCnt = 1 To iRange_Row
        If ThisWorkbook.Worksheets("Import").Range("D16") = "Revised!" Or _
           ThisWorkbook.Worksheets("Import").Range("D15") = "Revised!" Or _
           ThisWorkbook.Worksheets("Import").Range("D17") = "Revised!" Then
            Exit For
        End If
    For lCnt = 1 To iRange_Col
        If ThisWorkbook.Worksheets("Import").Range("D16") = "Revised!" Or _
           ThisWorkbook.Worksheets("Import").Range("D15") = "Revised!" Or _
           ThisWorkbook.Worksheets("Import").Range("D17") = "Revised!" Then
            Exit For
        End If
        Application.StatusBar = lCnt
        val = vArray(lRowCnt, lCnt)

       For Each keyw In Keywords
           found = InStr(1, val, keyw) <> 0
           If (found) Then
               Exit For
           End If
       Next

    If found Then
        If keyw = "," Then
            ThisWorkbook.Worksheets("Import").Range("D15") = "Revised!"
        Else
            If keyw = Chr(24) Then
                ThisWorkbook.Worksheets("Import").Range("D17") = "Revised!"
            Else
                If keyw = keyw = "'" Then
                    ThisWorkbook.Worksheets("Import").Range("D16") = "Revised!"
                End If
            End If
        End If


    End If


    Next lCnt
 Next lRowCnt

Answer 1

加快速度的一件事是评论Application.StausBar行。在我的情况下，处理40,000行从2.5分钟到不到7秒。此外，正如泰德威廉姆斯所建议的那样，这个例子一次突出显示所有被标记的细胞。希望这有用。

Sub findHilite()

    Dim Keywords As Variant
    Dim SearchRange As Range
    Dim vArray As Variant
    Dim lCnt As Long
    Dim lRowCnt As Long
    Dim keyw As Variant
    Dim val As String
    Dim lastrow2 As Long
    Dim rBld As Range

    Keywords = Array(Chr(34), "'", ",")
    lastrow2 = ThisWorkbook.Worksheets("Data").Range("A" & Rows.Count).End(xlUp).Row
    Set SearchRange = ThisWorkbook.Sheets("Data").Range("A1:BK" & lastrow2)

    SearchRange.Interior.ColorIndex = xlNone

    vArray = SearchRange

    For lRowCnt = 1 To SearchRange.Rows.Count 'rows loop
        For lCnt = 1 To SearchRange.Columns.Count 'columns loop
'            Application.StatusBar = lRowCnt 'display row count
            val = vArray(lRowCnt, lCnt)

            For Each keyw In Keywords
                If InStr(1, val, keyw) <> 0 Then
    '               build range consisting of flagged cells
                    If Not rBld Is Nothing Then
                        Set rBld = Union(rBld, SearchRange(lRowCnt, lCnt))
                    Else
                        Set rBld = SearchRange(lRowCnt, lCnt)
                    End If
                    Exit For
                End If
            Next

        Next lCnt
    DoEvents
    Next lRowCnt
    On Error Resume Next
    rBld.Interior.ColorIndex = 3 'hilite flagged cells in one step, saves time
    On Error GoTo 0

End Sub

我的数组循环非常慢。有没有办法改善这个？

1 个答案: