☰

在 Excel 宏中使用 Match() 代替 Find()

tag-icon • tag-icon microsoft-excel vba macros
在 Excel 宏中使用 Match() 代替 Find()

我使用宏大约 11 年了，没有遇到任何问题。但是，在过去 18 个月中，我使用它的一些工作簿非常大，在这种情况下，宏可能需要很长时间才能运行。

为了解决这个问题，我修改了宏以禁用事件和屏幕更新，并使计算“手动”。这大大改善了情况，但有时改进还不够。

例如，昨天我运行宏来比较 288,000 个电子邮件地址列表与另一个 235,000 个电子邮件地址列表，以确定是否有匹配项。这花了大约 14 个小时才完成（因此超出了一个典型的工作日）。

我做了一些研究（1，2等），并已确定使用Match()将比快得多Find()。

但是，我在修改代码以使用时遇到了问题Match()。以下是当前使用的工作代码Find()：

Sub FindMatchingData()

Application.EnableEvents = False
Application.Calculation = xlManual
Application.ScreenUpdating = False

Dim MySearchRange As Range
Dim c As Range
Dim findC As Variant

Set MyRange = Application.InputBox( _
Prompt:="Select the range of cells containing the data you are looking for:", Type:=8)

Set MySearchRange = Application.InputBox( _
    Prompt:="Select the range you wish to investigate:", Type:=8)

Response = InputBox(Prompt:="Specify the comment you wish to appear to indicate the data was found:")

MyOutputColumn = Application.InputBox( _
Prompt:="Enter the alphabetical column letter(s) to specify the column you want the message to appear in.")
    
Set Sht = MyRange.Parent

  For Each c In MyRange
    If Not c Is Nothing Then
    
Set findC = MySearchRange.Find(c.Value, LookIn:=xlValues)

        If Not findC Is Nothing Then
           Sht.Range(MyOutputColumn & c.Row).Cells.Value = Response
        End If
    End If
  Next
Excel.Application.SendKeys Keys:="^{HOME}", Wait:=True
DoEvents

Application.EnableEvents = True
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True

MsgBox "Investigation completed."

End Sub

问题：

  • 有人能否建议是否可以轻松修改上述代码以使用 Match()，或者我是否最好从头开始？
  • 如果可以修改的话，我将非常感激任何帮助，因为我似乎遇到了瓶颈。

附加信息：宏的预期行为

此宏为用户提供了一种简单的方法来查找两个范围之间的匹配数据，无论是在同一工作表内还是在同一工作簿内的不同工作表之间。

预期行为如下：

  1. 它提示用户：
  • 选择包含所需数据的范围
  • 选择要搜索的范围，查看数据是否也存在于该范围
  • 输入注释，用于指示任何匹配的数据
  • 如果找到匹配项，请输入要在其中填充评论的列
  1. 然后，Excel 继续运行所选范围之间的比较，并在找到匹配项的地方开始填充所选列。
  2. 完成后，它会向用户显示调查已完成信息。

例如，如果用户选择工作表 1 中的区域 A2:A40000 作为包含要查找的数据，然后选择工作表 2 中的区域 C2:C2000 作为要搜索的区域，然后输入单词“Yes”作为注释，并选择 D 作为列，则完成后的预期结果是，如果找到了数据，用户将看到工作表 1 中的 D 列中的单元格将包含单词“Yes”。

答案1

正如您链接的文章和我在评论中所说的那样，循环数组比查找或匹配更快，并使用 for 循环：

Sub FindMatchingData()

    Application.EnableEvents = False
    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    
    Dim MySearchRange As Range
    Dim c As Range
    Dim findC As Variant
    
    Set myrange = Application.InputBox( _
    Prompt:="Select the range of cells containing the data you are looking for:", Type:=8)
    
    Dim myRangeArray As Variant
    myRangeArray = myrange.Value
    
    Set MySearchRange = Application.InputBox( _
        Prompt:="Select the range you wish to investigate:", Type:=8)
    
    Dim MSRArray As Variant
    MSRArray = MySearchRange.Value
    
    Dim Response As String
    Response = InputBox(Prompt:="Specify the comment you wish to appear to indicate the data was found:")
    
    myoutputcolumn = Application.InputBox( _
    Prompt:="Enter the alphabetical column letter(s) to specify the column you want the message to appear in.")
        
    Dim outArray As Variant
    ReDim outArray(1 To UBound(myRangeArray, 1), 1 To 1)
    
    
    
        
    Set sht = myrange.Parent
    
    Dim i As Long
    For i = 1 To UBound(myRangeArray, 1)
        Dim j As Long
        For j = 1 To UBound(MSRArray, 1)
            If myRangeArray(i, 1) = MSRArray(j, 1) Then
                outArray(i, 1) = Response
                Exit For
            End If
        Next j
    Next i
    
    sht.Cells(myrange.Row, myoutputcolumn).Resize(UBound(outArray, 1), 1).Value = outArray
            
    sht.Activate
    sht.Range("A1").Select
    
    
    Application.EnableEvents = True
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "Investigation completed."

End Sub

相关内容