Question

我使用以下VBA代码来比较来自＆＃39; Sheet1＆＃39;的60K记录（仅限特定字符串）。来自＆＃39; Sheet2＆＃39;的7K记录。它需要很长时间才能完成并且有时没有响应。反正有没有提高这个子程序的性能？

Sub txtext()

Dim fnl As String, stl As String, env As String, typ As String
Dim ctm As String
Dim stdate As Date, enddate As Date

lr = Sheets("cid_match").Range("A" & Rows.Count).End(xlUp).Row
cr = Sheets("scme").Range("C" & Rows.Count).End(xlUp).Row
stdate = Now
m = 2

For Each e In Sheets("cid_match").Range("BI2:BI" & lr).Cells
stl = Worksheets("cid_match").Range("BI" & m).Cells.Value
typ = Worksheets("cid_match").Range("BK" & m).Cells.Value
s = 2
    For Each r In Sheets("scme").Range("C2:C" & cr).Cells
        ctm = Worksheets("scme").Range("B" & s).Cells.Value
        fnl = r.Value

        If InStr(fnl, stl) > 0 And ctm = typ Then
            Worksheets("cid_match").Range("BJ" & m).Value = fnl
            GoTo sss
        End If
    s = s + 1
    Next r
sss:
m = m + 1
Next e

enddate = Now
MsgBox "Succesfully Completed!!! Started at " & stdate & " Ended at " & enddate

End Sub

Answer 1

为了优化搜索记录，您需要先使用快速排序或 bubblesort 对数据进行排序。然后，您就可以使用二进制搜索进行搜索。这将大大减少您的等待时间。幸运的是，这些功能已经由其他开发人员用VBA编写。

<强>冒泡

Sub BubbleSort(list()) 
'   Sorts an array using bubble sort algorithm
    Dim First As Integer, Last As Long 
    Dim i As Long, j As Long 
    Dim Temp As Long 

    First = LBound(list) 
    Last = UBound(list) 
    For i = First To Last - 1 
        For j = i + 1 To Last 
            If list(i) > list(j) Then 
                Temp = list(j) 
                list(j) = list(i) 
                list(i) = Temp 
            End If 
        Next j 
    Next i 
End Sub

二进制搜索

Function arrayFind(theArray() As Integer, target As Integer) As Boolean
    Dim low As Integer
    low = 0
    Dim high As Integer
    high = UBound(theArray)
    Dim i As Integer
    Dim result As Boolean

    Do While low <= high
        i = (low + high) / 2
        If target = theArray(i) Then
            arrayFind = True
            Exit Do
        ElseIf target < theArray(i) Then
            high = (i - 1)
        Else
            low = (i + 1)
        End If
    Loop

    If Not arrayFind Then
        arrayFind = False
    End If
End Function

Answer 2

请尝试以下方法： -

Sub Sample()
Dim AryLookup()     As String
Dim DteStart        As Date
Dim LngCounter      As Long
Dim LngRow          As Long
Dim WkSht           As Worksheet

DteStart = Now

'Look at the lookup worksheet
Set WkSht = ThisWorkbook.Worksheets("scme")

    'Make an array the same size as the dataset
    ReDim AryLookup(WkSht.Range("C" & Rows.Count).End(xlUp).Row)

    'Copy the dataset in
    For LngRow = 2 To UBound(AryLookup, 1)
        AryLookup(LngRow - 2) = WkSht.Range("C" & LngRow)
        DoEvents
    Next

Set WkSht = Nothing

'Look at the source worksheet
Set WkSht = ThisWorkbook.Worksheets("cid_match")

    'Work from the bottom up so not to be falsly stopped by an empty row
    'Step -1 means go backwards by one with each itteration of the loop
    For LngRow = WkSht.Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1

        'Look through the loop for a match
        For LngCounter = 0 To UBound(AryLookup, 1)

            'If it matches then add it to the column and exit the loop
            If InStr(1, WkSht.Range("BI" & LngRow), AryLookup(LngCounter)) > 0 Then
                WkSht.Range("BJ" & LngRow).Value = AryLookup(LngCounter)
                Exit For
            End If

            DoEvents
        Next

        DoEvents
    Next
Set WkSht = Nothing

MsgBox "Succesfully Completed!!! " & vbNewLine & "Started at " & DteStart & vbNewLine & "Ended at " & Now

End Sub

查看代码非常令人困惑，无法关注正在发生的事情，在某些情况下，我无法理解或看到代码中发生的事情的好处，因此上面的可能没有是对的。你应该总是编写你的代码，假设另一个开发人员需要提取并支持它，如果你必须在几年后再回到它想要记住发生的事情，它将来会帮助你。

Excel VBA InStr非常慢和悬挂

2 个答案: