使用查找function时出错
我有两张表。 Sheet1：上周，sheet2：本周。
我在sheet2的A列中查找带有sheet1的ID，如果它们匹配，则将sheet1的列M的值复制到sheet2的列M.
由于某种原因，我不在sheet1中find的值被填充为“0”。 我不希望这发生，我的代码。 我只想要代码来查找ID，如果他们匹配我想要的价值，否则我不想要打印任何东西。
有人可以build议我哪里错了？
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 
代替
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
尽pipe您的代码可以使用工作表和范围variables进行修改。 并确保你使用正确的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
表本周
你可以尝试这样的事情…
如有需要，请更正表单参考。 目前它假定这张表被称为本周和最后一周。
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
代码将是这样的。
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