在另一个工作表中搜索 2 个条件并返回单元格值

Question

我正在尝试将姓名和日期从一张表匹配到另一张表，并从该表返回相应的单元格值以填充一列。

要填充的活动工作表有 24000 行，要匹配和复制数据的工作表有 14645。列是名称、日期、每个中的中断时间（其中的名称是较短的字符串 ID，因此使用 @987654321 @（例如“Willia”和“WilliamsA”）。

我的代码遍历了大约 200 行并结束。不确定是崩溃还是错误。任何帮助表示赞赏。

Sub matchnamedate()

Application.ScreenUpdating = false

Dim i As Integer
Dim rcell As Range
Dim rrng As Range

Set rrng = Range("T2:T24000")
Range("t2").Activate

For Each rcell In rrng

For i = 2 To 14645

If InStr(1, Worksheets("Max Breaks by Day").Cells(i, 1).Text, ActiveCell.Offset(0, -2).Text) And ActiveCell.Offset(0, -1).Value = Worksheets("Max Breaks by Day").Cells(i, 2) Then


ActiveCell.Value = Worksheets("Max Breaks by Day").Cells(i, 3).Value
ActiveCell.Offset(1, 0).Activate


End If
Next i

Next rcell

End Sub

Answer 1

您从不使用rcell，因此有效地您的外循环可能只是一个For j = 1 To 23999（或任何大数字）。您的主要问题是，在您的内部循环中，您只能移动到下一个要比较的单元格如果前一个已匹配，尽管有时您对外部循环的每次迭代执行不止一次环形。如果您实际上不匹配单元格，那么对于外部循环的剩余迭代，您只是不断尝试匹配不匹配的单元格 - 一个毫无意义的练习。

我相信以下内容将实现您的目标：

Sub matchnamedate()

    Application.ScreenUpdating = False

    Dim i As Long
    Dim rcell As Range
    Dim rrng As Range

    Set rrng = Range("T2:T24000")

    For Each rcell In rrng

        For i = 2 To 14645
            If InStr(1, Worksheets("Max Breaks by Day").Cells(i, 1).Text, rcell.Offset(0, -2).Text) > 0 And _
               Worksheets("Max Breaks by Day").Cells(i, 2) = rcell.Offset(0, -1).Value Then

                rcell.Value = Worksheets("Max Breaks by Day").Cells(i, 3).Value
                'Exit if a match has been found
                Exit For
            End If
        Next i

    Next rcell

    Application.ScreenUpdating = True
End Sub