Excel VBA Condtional VLookup

Question

Я использую функцию VLookup для отображения Tabelle5.Range("A:A") на основе идентификационных номеров в Tabelle3.Cells(7 + i, 1).Если идентификационный номер находится в Tabelle5.Range("A:A"), то различные ячейки из этой строки должны быть скопированы в правые ячейки в (строке) Tabelle3.Cells(7 + i, 1).Это работает нормально со следующим кодом.

Sub VLookup

Dim lastrow As Long
Dim NFR As Long


lastrow = Tabelle5.Range("A" & Rows.Count).End(xlUp).Row
NFR = Tabelle3.Range("B" & Rows.Count).End(xlUp).Offset(-1).Row
Set myrange = Tabelle5.UsedRange


For i = 2 To lastrow


On Error Resume Next

    If Tabelle3.Cells(7 + i, 1) <> "" And Not IsError(Application.Match(Tabelle3.Cells(7 + i, 1), Tabelle5.Range("A:A"), False)) Then


        Tabelle3.Cells(7 + i, 2) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange, 2, False)


        Tabelle3.Cells(7 + i, 3) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange, 3, False)


        Tabelle3.Cells(7 + i, 4) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange, 4, False)

    End If

Next i

End Sub

Моя проблема здесь в том, что в Tabelle3 могут быть ячейки, которые уже содержат данные.Эти данные будут перезаписаны «новыми» данными из Tabelle5.Однако может случиться так, что «новые» данные из Tabelle5 будут пустой ячейкой.Это будет означать, что я потеряю данные, потому что заполненная ячейка будет перезаписана пустой ячейкой.

РЕДАКТИРОВАТЬ Кто-нибудь знает, как применять Vlookup, только если идентификационный номер из Tabelle3.Cells(7 + i, 1) также найден в Tabelle5.Range("A:A") (для этого я использую Vlookup) и ввторой шаг принимает только непустые ячейки от myrange Column 2,3, and 4.

Пример Идентификационный номер из Tabelle3.Cells(12, 1) находится в Tabelle5.Cells(29,1).Row 29 in Tabelle5 содержит следующие значения:

• Идентификационный номер A29
• B29 Новые данные
• C29 Пусто
• D29 Новые данные

На следующем шаге я хочу, чтобы мой код только копировал «Новые данные» из B29 и D29 в определенные ячейки в Tabelle3, но пропускал C29, потому что это пустая ячейка, и это может перезаписать уже заполненную ячейку в Tabelle3.

Answer 1

Этот метод использует FIND для получения ссылки на правильную ячейку в столбце А. Затем он использует OFFSET для проверки значений в различных столбцах перед копированием значений по всему.
Это предполагает, что идентификационные номерауникальный на обоих листах.

Public Sub ReplaceFigures()

    Dim rT5_LastCell As Range
    Dim rT3_LastCell As Range
    Dim rCell As Range
    Dim rFound As Range

    'References to last cell in column A.
    Set rT5_LastCell = Tabelle5.Range("A" & Tabelle5.Rows.Count).End(xlUp)
    Set rT3_LastCell = Tabelle3.Range("A" & Tabelle3.Rows.Count).End(xlUp)

    'rcell will be a direct reference to the column A cell in Tabelle3
    'rFound will be a direct reference to the column A cell in Tabelle5 (or nothing).
    With Tabelle5.Range("A1", rT5_LastCell)
        For Each rCell In Tabelle3.Range("A1", rT3_LastCell)
            Set rFound = .Find(What:=rCell, _
                               LookIn:=xlValues, _
                               LookAt:=xlWhole, _
                               SearchDirection:=xlNext)

            If Not rFound Is Nothing Then 'A match has been found.
                'If the Tabelle3 value is empty then copy the Tabelle5 value across.
                If rCell.Offset(, 1) = "" Then rCell.Offset(, 1) = rFound.Offset(, 1) 'column B.
                If rCell.Offset(, 2) = "" Then rCell.Offset(, 2) = rFound.Offset(, 2) 'column C.
                If rCell.Offset(, 3) = "" Then rCell.Offset(, 3) = rFound.Offset(, 3) 'column D.
            End If
        Next rCell
    End With

End Sub  

Для быстрого тестирования макроса добавьте приведенный ниже код, а затем вставьте StartTimer вверху кода ReplaceFigures() и StopTimer внизу.

Private Declare Function GetTickCount Lib "kernel32" () As Long

Public CodeTimer As Long

'^^^^^ Top of module ^^^^^^

Public Function StartTimer()
    CodeTimer = GetTickCount
End Function

Public Function StopTimer()
    Dim FinalTime As Long
    FinalTime = GetTickCount - CodeTimer
    MsgBox Format(Now(), "ddd dd-mmm-yy hh:mm:ss") & vbCr & vbCr & _
            Format((FinalTime / 1000) / 86400, "hh:mm:ss") & vbCr & _
            FinalTime & " ms.", vbOKOnly + vbInformation, _
        "Code Timer"
    CodeTimer = 0
End Function

Answer 2

Вы можете вкладывать свои операторы if в другой оператор if, как любезно предложил Банан:

If Tabelle5.Cells(7 + i, 1) <> "" Then

    If Tabelle3.Cells(7 + i, 1) <> "" And Not IsError(Application.Match(Tabelle3.Cells(7 + i, 1), Tabelle5.Range("A:A"), False)) Then

        Tabelle3.Cells(7 + i, 2) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange, 2, False)

        Tabelle3.Cells(7 + i, 3) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange, 3, False)

        Tabelle3.Cells(7 + i, 4) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange, 4, False)

    End If

End If

ОБНОВЛЕНО:

В этом случае вы можете использоватьоператоры для применения каждого из ваших VLookups следующим образом:

If Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange, 2, False) <> "" Then Tabelle3.Cells(7 + i, 2) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange, 2, False)

или

res1 = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange, 2, False)
If res1 <> "" Then Tabelle3.Cells(7 + i, 2) = res1

Существуют, конечно, лучшие способы для всей этой логики, но это должно помочь по крайней мере заставить ваш код работать.