Мой код ищет значения на одном листе A на другом листе B и вводит данные из столбца в B, если значения в A и B совпадают.
Однако я пытаюсь скопировать эти строки, где Vlookup возвращает #NA в конец данных A. Однако, как я это делаю, for l oop остается в первом индексе и копирует 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