使用查找功能时出错

Question

我有两张纸。 Sheet1：上周，和sheet2：本周。

我正在使用sheet1在sheet2的A列中查找我的ID，如果它们匹配，我将从sheet1的M列复制到sheet2的M列。

由于某种原因，我在sheet1中找不到的值被填充为＆＃34; 0＆＃34;。我不想用我的代码发生这种情况。我只是想让代码查找ID，如果匹配我想要的值，否则我不想要打印任何东西。

有人可以建议我哪里出错吗？

Sub lookup()
Dim tr As Long
Dim trsh As Long
tr = Sheets("ThisWeek").Cells(Rows.Count, "A").End(xlUp).Row
trsh = Sheets("ThisWeek").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("ThisWeek").Range("M2:M" & tr).Formula = Application.WorksheetFunction.IfError(Application.VLookup(Sheets("ThisWeek").Range("A2:A" & trsh), Sheets("LastWeek").Range("$A:$P"), 13, 0), "")
End Sub

Answer 1

而不是

Sheets("ThisWeek").Range("M2:M" & tr).Formula = Application.WorksheetFunction.IfError(Application.VLookup(Sheets("ThisWeek").Range("A2:A" & trsh), Sheets("LastWeek").Range("$A:$P"), 13, 0), "")

试

Dim cel as Range
For Each cel In Sheets("ThisWeek").Range("M2:M" & tr)
    cel.Offset(0, 1).Formula = Application.WorksheetFunction.IfError(Application.VLookup(cel, Sheets("LastWeek").Range("$A:$P"), 13, 0), "")
Next cel

虽然您的代码可以使用工作表和范围变量进行修改。并确保使用正确的tr和trsh。

修改

Sub lookupPSQM()
    Dim thisWeekLR As Long, lastWeekLR As Long
    Dim thisWeekSht As Worksheet, lastWeekSht As Worksheet
    Dim rng As Range, cel As Range

    Set thisWeekSht = ThisWorkbook.Sheets("ThisWeek")
    Set lastWeekSht = ThisWorkbook.Sheets("LastWeek")

    thisWeekLR = thisWeekSht.Cells(Rows.Count, "A").End(xlUp).Row
    'lastWeekLR = lastWeekSht.Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = thisWeekSht.Range("A2:A" & thisWeekLR)

    For Each cel In rng
        cel.Offset(0, 12).Formula = Application.WorksheetFunction.IfError(Application.VLookup(cel, Sheets("LastWeek").Range("$A:$P"), 13, 0), "")
    Next cel
End Sub

参见图片以供参考。

工作表 LastWeek

工作表 ThisWeek

Answer 2

您可以尝试这样的事情......

如果需要，请更正工作表参考。目前，它假定这些工作表被称为ThisWeek和LastWeek。

Sub lookupPSQM()
Dim wsSource As Worksheet, wsDest As Worksheet
Dim tr As Long

With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set wsSource = Sheets("LastWeek")
Set wsDest = Sheets("ThisWeek")

tr = wsDest.Cells(Rows.Count, "A").End(xlUp).Row

wsDest.Range("M2:M" & tr).Formula = "=IfError(VLookup(A2,'" & wsSource.Name & "'!A:M, 13, 0), """")"

With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub

Answer 3

代码就是这样。

Sub test()
    Dim Ws As Worksheet, toWs As Worksheet
    Dim vDB, vR(), vDB2
    Dim i As Long, j As Long

    Set toWs = Sheets("ThisWeek")
    Set Ws = Sheets("LastWeek")

    vDB = Ws.Range("a1").CurrentRegion
    vDB2 = toWs.Range("a1").CurrentRegion

    n = UBound(vDB2, 1)
    ReDim vR(1 To n - 1, 1 To 1)
    For i = 2 To n
        For j = 2 To UBound(vDB, 1)
            If vDB2(i, 1) = vDB(j, 1) Then
                vR(i - 1, 1) = vDB(j, 13)
                Exit For
            End If
        Next j
    Next i
    toWs.Range("m2").Resize(n - 1) = vR

End Sub