Попытка найти пары данных в любом месте листа

Question

Итак, у меня есть лист Excel, где я хочу просмотреть Sheet1 и найти пары данных, подобные Sheet2. Итак, у меня есть, например, A1:B1, и мне нужно найти строку на Sheet2, которая имеет точно такие же значения рядом друг с другом (но это может быть A33:B33 или где угодно), и скопировать строку в Sheet1(в столбце C или в любом другом месте)

Я также пытаюсь сделать его динамическим циклом, чтобы он проверял пару A1:B1 против Sheet2, затем A2:B2 и т. д. до последней строки.

Теперь у меня есть код, который проверяет только, если A1:B1 на Sheet1 соответствует A1:B1 на Sheet2 (но не где-нибудь на листе). Кроме того, я не могу сделать так, чтобы он динамически проверял каждую строку на 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

Пожалуйста, помогите, я боролся с этим уже несколько дней, и мне нужно сдать отчет к концу сегодняшнего дня, и я просто не могу найти ничего полезного в Интернете. Я очень ценю любой совет

Answer 1

Попробуйте код ниже (комментарии в коде):

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

Answer 2

Я не проверял это.

Я предполагал, что вы ищете значения листа А1 только в столбце листа А2.

Когда совпадение найдено, значение столбца С наsheet2 копируется в столбец C на sheet1.

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

Answer 3

Чтобы получить пары Sheet1 и найти их в Sheet2:

Я использовал этот код:

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

Вывод этого кода:

Это номера строк, в которых находятся пары. Вам просто нужно добавить код, чтобы скопировать всю строку.

Надеюсь, это поможет

Answer 4

Если вы хотите использовать циклы, попробуйте:

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