Question

Source sheet ("Sheet2") Output sheet ("Sheet3")

我在＆＃34; Sheet2＆＃34;中有一个名称和相关值列表。我在＆＃34; Sheet3＆＃34;中有另一个名单。如果Sheet3中的名称也可以在Sheet3中找到，我想在Sheet3中与名称相邻的列中添加相关值。

为此，我创建了一个嵌套循环，其行为如下;

在＆＃34; sheet2＆＃34;中循环所有名称（＆＃34; X＆＃34;）
对于这些名称中的每一个，迭代所有名称（＆＃34; Y＆＃34;）＆＃34;表3＆＃34;
值匹配时，在＆＃34; Sheet2＆＃34;上执行VLookup并突出显示单元格以标记已添加值。

当两个表托管在同一工作表中时，此代码工作正常。在尝试跨两个不同的工作表复制此行为时（通过确保将显式工作表引用添加到所有范围），它不会执行任何操作。

非常感谢任何帮助

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.WorksheetFunction.VLookup替换了您的双For循环和Application.Match - 这将为您节省一笔费用很多运行时间。

您遇到的一些错误：

由于您之前设置outputrange，因此当您运行此行For Each Y in Worksheets("Sheet3").outputrange时会出现错误，而您可以使用For Each Y In OutputRange
您的某些“lastrow”和“lastcolumn”值不完全合格，inputbottomrow = Worksheets("Sheet2").Cells(Rows.Count, inputcolumn).End(xlUp).Row必须为inputbottomrow = Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, inputcolumn).End(xlUp).Row。这就是为什么我要么定义Worksheet类型的变量并将其分配给它，要么使用With语句。

Side-Note ：我在开始时用大写字母修改了变量（这是我调试的方式，编码时没有任何错别字）< / p>

代码

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

使用VBA跨两个工作表进行Vlookup

1 个答案: