Excel 尝试在工作表中的任意位置查找数据对

因此，我有一个excel工作表，我想在其中循环查看

Sheet1

，并找到类似

Sheet2

的数据对。例如，我有

A1:B1

，我需要在

Sheet2

上找到一行，该行的相邻值完全相同（但可以是

A33:B33

或任何地方），然后将该行复制到

Sheet1

（在C列或任何地方）

我还试图使它成为一个动态循环，以便它检查

A1:B1

对

Sheet2

，然后检查

A2:B2

，依此类推，直到最后一行

现在，我的代码只检查

Sheet1

上的

A1:B1

是否与

Sheet2

上的

A1:B1

匹配（但不在工作表的任何位置）。此外，我无法使它动态地检查

Sheet1

上的每一行（我尝试使用

x=x+1

进行检查，但不起作用）

这是我的密码：

Sub matchme()

    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim r As Range

    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    r = lastrow = sh1.Range("A" & Rows.Count).End(xlUp).Row    

    For x = 1 To r    
        If sh1.Range("A" & x) = sh2.Range("A" & x) And sh1.Range("B" & x) = sh1.Range("A" & x) & sh2.Range("B" & x) Then 
            sh1.Range("A" & x).EntireRow.Copy Destination:=sh2.Range("C" & x)    
        x = x + 1    
    Next x


End Sub

---

请帮忙，我已经为此挣扎了好几天了，我需要在今天结束前交一份报告，我只是在互联网上找不到任何有用的东西。非常感谢您的建议

如果您想使用循环，请尝试：

Sub matchme()

    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim x As Long
    Dim i As Long
    Dim j As Long

    Dim lastrow As Long
    Dim lastRow2 As Long
    Dim lastCol2 As Long

    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    lastrow = sh1.Range("A" & Rows.Count).End(xlUp).Row

    With sh2
        lastRow2 = .Cells(Rows.Count, 1).End(xlUp).Row
        lastCol2 = .Cells(1, Columns.Count).End(xlUp).Column
    End With

    For x = 1 To lastrow

        For i = 1 To lastRow2

            For j = 1 To lastCol2

                If sh1.Cells(x, 1) = sh2.Cells(i, j) Then

                    If sh1.Cells(x, 2) = sh2.Cells(i, j + 1) Then

                        MsgBox "Found match!"

                    End If

                End If

            Next j

        Next i

    Next x

End Sub

我还没有测试过这个

我假设您只在sheet2 A列中搜索sheet1 A值

找到匹配项后，表2上的C列值将复制到表1上的C列

Sub x()

Dim rFind As Range, s As String, r As Range

With Sheet1
    For Each r In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
        Set rFind = Sheet2.Columns(1).Find(What:=r.Value, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
        If Not rFind Is Nothing Then
            s = rFind.Address
            Do
                If rFind.Offset(, 1).Value = r.Offset(, 1).Value Then
                    r.Offset(, 2).Value = rFind.Offset(, 2).Value
                End If
                Set rFind = Sheet2.Columns(1).FindNext(rFind)
            Loop While rFind.Address <> s
        End If
    Next r
End With

End Sub

subx（）
Dim rFind作为范围，s作为字符串，r作为范围
附页1
对于每个r In.范围（“A1”、.Range（“A”&Rows.Count）.End（xlUp））
设置rFind=Sheet2.Columns（1）.Find（What:=r.Value，Lookat:=xlother，MatchCase:=False，SearchFormat:=False）
如果不是，那么rFind什么都不是
s=查找地址
做
如果rFind.Offset（，1）.Value=r.Offset（，1）.Value，则
r、 偏移量（，2）.Value=rFind.Offset（，2）.Value
如果结束
设置rFind=Sheet2.列（1）.FindNext（rFind）
在rFind.Address s时循环
如果结束
下一个r
以
端接头

要获取成对的表1并在表2中查找它们，请执行以下操作：

我使用了以下代码：

Application.ScreenUpdating = False
Dim i As Long
Dim LastRow As Long

Dim rng As Range

Dim wk1 As Worksheet
Dim wk2 As Worksheet

Dim SearchThis As String

Set wk1 = ThisWorkbook.Worksheets("Sheet1")
Set wk2 = ThisWorkbook.Worksheets("Sheet2")

LastRow = wk1.Range("A" & wk1.Rows.Count).End(xlUp).Row

'<--------------------------------->
'For more type of SPECIAL CELLS, and choose exactly the type you need
'please read https://docs.microsoft.com/en-us/office/vba/api/excel.range.specialcells

For i = 1 To LastRow Step 1
    SearchThis = UCase(wk1.Range("A" & i).Value & wk1.Range("B" & i).Value)

    For Each rng In wk2.Cells.SpecialCells(xlCellTypeConstants, 23)
        If UCase(rng.Value & rng.Offset(0, 1).Value) = SearchThis Then
            'code to copy where you want
            Debug.Print rng.Row
        End If
    Next rng

Next i

Set wk1 = Nothing
Set wk2 = Nothing

Application.ScreenUpdating = True

Application.ScreenUpdate=False
我想我会坚持多久
最后一排一样长
变暗rng As范围
将wk1设置为工作表
将wk2设置为工作表
将此设置为字符串
设置wk1=此工作簿。工作表（“表1”）
设置wk2=此工作簿。工作表（“表2”）
LastRow=wk1.Range（“A”&wk1.Rows.Count）.End（xlUp）.Row
'
'以获取更多类型的特殊单元格，并选择所需的类型
“请读https://docs.microsoft.com/en-us/office/vba/api/excel.range.specialcells
对于i=1到最后一行步骤1
SearchThis=UCase（wk1.Range（“A”）和i.Value和wk1.Range（“B”）和i.Value）
对于wk2.Cells.SpecialCells中的每个rng（xlCellTypeConstants，23）
如果UCase（rng.Value和rng.Offset（0,1）.Value）=搜索此值，则
'要复制到所需位置的代码
Debug.Print rng.Row
如果结束
下一个rng
接下来我
设置wk1=无
设置wk2=无
Application.ScreenUpdating=True

此代码的输出为：

这些是配对所在的行号。您只需要添加一个代码来复制整行

希望这有帮助

尝试下面的代码（代码中的注释）：

---

谢谢，但是有没有办法用脚本来解决这个问题？你可以使用

Find

方法，这样你就不必遍历每个单元格了。很抱歉，第一次阅读时没有完全理解问题，没有正确阅读行到行的循环部分。我已经删除了注释：o）@SJR是对的，使用excels函数编写代码，如

.find

和

.match

example@SJR但是如果我们使用Find，那么在没有循环的情况下，我将无法动态地更改数据对以进行检查，对吗？你能用一个代码来说明你的方法吗？老实说，我对“查找和匹配”不太熟悉：o/不确定你的意思-我在下面发布了一些代码，让我知道你进展如何。

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim r As Range

Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
lastRow = sh1.Range("A" & Rows.Count).End(xlUp).Row
iLastRow = sh2.Range("A" & Rows.Count).End(xlUp).Row

For j = 1 To lastRow
    For i = 1 To iLastRow
        If sh1.Cells(j, 1) = sh2.Cells(i, 1) And sh1.Cells(j, 2) = sh2.Cells(i, 2) Then
            sh1.Cells(i, 3) = "Write some information"
        End If

        'you don't need to increment loop variable "Next" does it for you
        'also i is better suited for iterator name :)
    Next
Next