问题
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.
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
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
回答1:
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.
来源:https://stackoverflow.com/questions/63218031/copy-the-line-where-vlookup-loop-results-in-na-index-problem