使用VBA在两个工作表中进行Vlookup

源表（“Sheet2”） 输出表（“Sheet3”）

我有“Sheet2”中的名称和关联值列表。 我在“Sheet3”中有另一个名字列表。 如果sheet2中的名称也可以在Sheet3中find，我想在Sheet3中名称旁边的列中添加相关的值。

为此，我创build了一个嵌套的循环，其行为如下：

• 循环“sheet2”中的所有名称（“X”）
• 对于这些名称中的每一个，在“表单3”中迭代所有名称（“Y”），
• 在值匹配的地方，在“Sheet2”上执行一个VLookup并突出显示该单元以标记添加了一个值。

当两个表托pipe在同一工作表中时，此代码正常工作。 试图跨两个不同的工作表复制这种行为（通过确保明确的工作表引用被添加到所有范围），它不会做任何事情。

任何帮助将非常感激

 Sub colincrosssheet() On Error Resume Next Dim inputrange As Range Dim outputrange As Range Dim X As Range Dim Y As Range Dim inputtoprow As Integer Dim inputbottomrow As Integer Dim inputcolumn As Integer Dim outputtoprow As Integer Dim outputbottomrow As Integer Dim outputcolumn As Integer Dim rngFindin As Range Dim rngFindout As Range Dim vlookuprange As Range 'set input column, which contains the line item ids from Pacing Tool, and also sets bottom row Set rngFindin = Worksheets("Sheet2").Cells.Find("nameinput", LookIn:=xlValues, lookat:=xlWhole) If rngFindin Is Nothing Then MsgBox "Could not find 'Line Item Id' column in your SDF. Please review file.", vbOKOnly, "Column not found" Else inputtoprow = Worksheets("Sheet2").rngFindin.Row + 1 inputcolumn = Worksheets("Sheet2").rngFindin.Column inputbottomrow = Worksheets("Sheet2").Cells(Rows.Count, inputcolumn).End(xlUp).Row End If 'set output column, which contains the line item ids in the SDF, and also sets bottom row Set rngFindout = Worksheets("Sheet3").Cells.Find("nameoutput", LookIn:=xlValues, lookat:=xlWhole) If rngFindout Is Nothing Then MsgBox "Could not find 'Line Item Id' column in your SDF. Please review file.", vbOKOnly, "Column not found" Else outputtoprow = Worksheets("Sheet3").rngFindout.Row + 1 outputcolumn = Worksheets("Sheet3").rngFindout.Column outputbottomrow = Worksheets("Sheet3").Cells(Rows.Count, outputcolumn).End(xlUp).Row End If 'define Vlookup range' Set vlookuprange = Worksheets("Sheet2").Range(Cells(inputtoprow, inputcolumn), Cells(inputbottomrow, inputcolumn + 1)) 'defines input and output range which contain line item ids Set inputrange = Worksheets("Sheet2").Range(Cells(inputtoprow, inputcolumn), Cells(inputbottomrow, inputcolumn)) Set outputrange = Worksheets("Sheet3").Range(Cells(outputtoprow, outputcolumn), Cells(outputbottomrow, outputcolumn)) 'loop through input range and update relevant column in SDF with new bid values For Each X In Worksheets("Sheet2").inputrange For Each Y In Worksheets("Sheet3").outputrange If Worksheets("Sheet3").Y.Value = Worksheets("Sheet2").X.Value Then Worksheets("Sheet3").Y.Offset(ColumnOffset:=1).Value = Application.WorksheetFunction.VLookup(Worksheets("Sheet2").X.Value, Worksheets("Sheet2").vlookuprange, 2, False) Worksheets("Sheet3").Y.Offset(ColumnOffset:=1).Interior.ColorIndex = 28 End If Next Y Next X End Sub 

Answer 1

答案（代码和解释）有点长，但我想分享一些你的代码不起作用的原因，以及我在下面的更新版本中做了什么：

首先 ，在With Worksheets("Sheet2")下的一个部分中组织与您的InputSheet（“Sheet2”）相关的数据。 对于OutputSheet（“Sheet3”），在With Worksheets("Sheet3") 。

其次 ，我用一个For和一个Application.Matchreplace了你的double For循环和Application.WorksheetFunction.VLookup ，这会为你节省很多运行时间。

你有一些错误：

• 既然你是设置之前的输出范围，当您运行此行For Each Y in Worksheets("Sheet3").outputrange将引发一个错误，而不是你可以使用For Each Y In OutputRange
• inputbottomrow = Worksheets("Sheet2").Cells(Rows.Count, inputcolumn).End(xlUp).Row需要是inputbottomrow = Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, inputcolumn).End(xlUp).Row 。 这就是为什么我要么定义一个types为Worksheet的variables并将其赋值给它，要么使用With语句。

注意 ：我在开始时用大写字母修改了variables（这是我debugging的方法，编码时没有任何错别字 ）

码

 Option Explicit Sub colincrosssheet() On Error Resume Next Dim InputtopRow As Long Dim InputbottomRow As Long Dim Inputcolumn As Long Dim OutputtopRow As Long Dim OutputbottomRow As Long Dim OutputColumn As Long Dim rngFindin As Range Dim rngFindout As Range Dim VlookupRange As Range Dim InputRange As Range Dim OutputRange As Range Dim X As Range Dim Y As Range ' set input column, which contains the line item ids from Pacing Tool, and also sets bottom row With Worksheets("Sheet2") Set rngFindin = .Cells.Find("nameinput", LookIn:=xlValues, lookat:=xlWhole) If rngFindin Is Nothing Then MsgBox "Could not find 'Line Item Id' column in your SDF. Please review file.", vbOKOnly, "Column not found" Else InputtopRow = rngFindin.Row + 1 Inputcolumn = rngFindin.Column InputbottomRow = .Cells(.Rows.Count, Inputcolumn).End(xlUp).Row End If ' define input range which contain line item ids Set InputRange = .Range(.Cells(InputtopRow, Inputcolumn), .Cells(InputbottomRow, Inputcolumn)) End With 'set output column, which contains the line item ids in the SDF, and also sets bottom row With Worksheets("Sheet3") Set rngFindout = .Cells.Find("nameoutput", LookIn:=xlValues, lookat:=xlWhole) If rngFindout Is Nothing Then MsgBox "Could not find 'Line Item Id' column in your SDF. Please review file.", vbOKOnly, "Column not found" Else OutputtopRow = rngFindout.Row + 1 OutputColumn = rngFindout.Column OutputbottomRow = .Cells(.Rows.Count, OutputColumn).End(xlUp).Row End If ' define output range which contain line item ids Set OutputRange = .Range(.Cells(OutputtopRow, OutputColumn), .Cells(OutputbottomRow, OutputColumn)) End With Dim MatchRow As Variant ' loop through outputrange and update relevant column in SDF with new bid values For Each Y In OutputRange If Not IsError(Application.Match(Y.value, InputRange, 0)) Then ' check if Y is found anywhere in inputrange using the Match MatchRow = Application.Match(Y.value, InputRange, 0) + rngFindin.Row Y.Offset(, 1).Value = Worksheets("Sheet2").Cells(MatchRow, Inputcolumn + 1) Y.Offset(, 1).Interior.ColorIndex = 28 End If Next Y End Sub