复制 VLOOKUP 循环导致 NA 的行（索引问题）

Question

我的代码在另一个工作表 B 中查找一个工作表 A 中的值，如果 A 和 B 中的值匹配，则从 B 中的列输入数据。

但是，我试图复制那些行，其中 Vlookup 将 #NA 返回到 A 数据的末尾。不过，我这样做的方式是，for 循环保留在第一个索引处，并使用第一个索引内容复制 n 行。

    Dim LastCol As Long
    Dim rng As Range
    Set rng = TargetWorksheet.Cells ' Use all cells on the sheet
    LastCol = Last(2, rng) ' Find the last col
    lastRowM = TargetWorksheet.Cells(TargetWorksheet.Rows.Count, "A").End(xlUp).Row

    Dim rngToA         As Range
    Dim rngfromB       As Range
    Dim rngCelToA      As Range
    Dim rngCelfromB    As Range

    Set rngToA = TargetWorksheet.Range("$D$1:$D$700")
    Set rngfromB = ActiveSheet.Range("D13:D700")

    For Each rngCelToA In rngToA.Cells
        If Trim(rngCelToA) <> "" Then
            For Each rngCelfromB In rngfromB.Cells
                If UCase(Trim(rngCelToA)) = UCase(Trim(rngCelfromB)) Then
                    rngCelToA.Cells(, LastCol - 2) = Application.VLookup(rngCelToA, ActiveSheet.Range("D13:P700"), 13, False)
                    ElseIf IsError(Application.VLookup(rngCelToA, ActiveSheet.Range("D13:P700"), 13, False)) Then
                        'index rngCelfromB
                         ActiveSheet.Rows(rngCelfromB.Row).Copy Destination:=TargetWorksheet.Cells(lastRowM + 1, 1)
                         lastRowM = lastRowM + 1
                    Exit For
                End If
            Next rngCelfromB
        End If
    Next rngCelToA

    Set toCelToA = Nothing
    Set fromB = Nothing
    Set rngCelToA = Nothing
    Set rngfromB = Nothing
    Set rngCelCelToA = Nothing
    Set rngCelfromB = Nothing

这是 Last() 函数的代码：

    Function Last(choice As Long, rng As Range)
   'Ron de Bruin, 5 May 2008
   ' 1 = last row
   ' 2 = last column
   ' 3 = last cell
    Dim lrw As Long
    Dim lcol As Long

    Select Case choice

    Case 1:
        On Error Resume Next
        Last = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
        On Error GoTo 0

    Case 2:
        On Error Resume Next
        Last = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

    Case 3:
        On Error Resume Next
        lrw = rng.Find(What:="*", _
                       After:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
        On Error GoTo 0

        On Error Resume Next
        lcol = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

        On Error Resume Next
        Last = rng.Parent.Cells(lrw, lcol).Address(False, False)
        If Err.Number > 0 Then
            Last = rng.Cells(1).Address(False, False)
            Err.Clear
        End If
        On Error GoTo 0

    End Select
   End Function

Answer 1

即兴发挥，我认为您可以使用 2d 数组将匹配的值填充到其中，而不是按找到的方式复制，一旦数据位于 2d 数组中，您可以以任何顺序将其写回您喜欢的任何位置你喜欢（走过去，或者走下来，甚至斜着走（但那会很傻））。

关键是，您可以通过这种方式更好地控制数据的传输方式和位置，而不是找到您想要的数据并立即决定如何处理它。