复制VLOOKUP循环导致不适用的行(索引问题) [英] Copy the line where VLOOKUP Loop results in NA (index problem)

问题描述

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

My code looks up values in one worksheet A in another worksheet B, and inputs data from a column in B if the values in A and B match.

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

However, I am trying to copy those lines, where Vlookup returns #NA to the end of A data. The way I do it though, the for loop remains at the first index and copies an n-amount of lines with the first index content.

    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()函数的代码:

Here is the code for the Last()-funtion:

    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

推荐答案

只是袖手旁观，我认为一旦数据位于2d数组中，您就可以使用2d数组将匹配的值填充到其中，而不是像发现的那样进行复制，您可以按照自己喜欢的顺序将其写回到任何您喜欢的位置(走过去，走下去甚至对角走(但这很愚蠢)).

Just off the cuff, I think you could use a 2d array to stuff the matched values into instead of copying as found, once the data is in a 2d array, you can write it back out to wherever you like in whatever order you like (walk across, or walk down, or even walk diagonally (but that would be silly)).

关键是，与查找所需数据并立即决定如何处理数据相比，您可以通过这种方法控制数据的处理方式和位置，从而好得多.

The point is, you can control how and where the data goes a lot better this way vs finding the data you want and immediately having to decide what to do with it.

这篇关于复制VLOOKUP循环导致不适用的行(索引问题)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！