使用查找功能时出错

Question

我有两张床单。 Sheet1 ：上周，sheet2 ：本周。

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

由于某种原因，我在 sheet1 中找不到的值被填充为“0”。我不希望这种情况发生，我的代码。我只想让代码查找 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

查看图片以供参考。

表格上周

工作表本周

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