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

您可以将if语句嵌套在另一个if语句下，正如Banana所建议的那样：

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

<强>更新：

在这种情况下，您可以使用if语句来应用每个VLookup：

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

对于整个逻辑肯定有更好的方法，但这应该有助于让代码至少运行。

Answer 2

此方法使用FIND获取对A列中正确单元格的引用。然后，在复制值之前，使用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

Excel VBA Condtional VLookup

2 个答案: