Как проверить, равны ли ячейки на разных листах?

Question

Сценарий: 2 сравниваемых листа.Диапазон для Sheet1 - B2: B, а для Sheet2 - C2: C.

Требование:

• Лист1 B2 = Лист2 C2
• Лист1 B3 = Лист2 C3 и так далее ...

См. Мойсуществующий код ниже:

Sub MessageCode()

    Dim FoundBlank1 As Range
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
    Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Dim MyRange As Range, MyCell As Range, MyRange2 As Range, MyCell2 As Range

    Set MyRange = ws.Range("B2:B" & ws.Range("B" & ws.Rows.Count).End(xlUp).Row)
    Set MyRange2 = ws2.Range("C2:C" & ws2.Range("C" & ws2.Rows.Count).End(xlUp).Row)
    Set MyCell2 = MyRange2


    For Each MyCell In MyRange

       If MyCell.Value <> Worksheets("Sheet2").Range("C2").Value Then

            MyCell.Copy
            Worksheets("Sheet3").Select
            Set FoundBlank1 = Range("A1:A1000").Find(What:="", lookat:=xlWhole)
            FoundBlank1.Select
            Selection.PasteSpecial xlPasteValues

            ActiveCell.Offset(0, 1).Value = "Incorrect Value."

        End If

    Next MyCell

    End Sub

Answer 1

Я добавил в дополнительное окно сообщения, если количество строк в листах 1 и 2 не совпадает.

Попробуйте это:

Sub Messagecode()

Dim ws As Worksheet
Dim ws2 As Worksheet
Dim lastrow1 As Integer
Dim lastrow2 As Integer
dim lastrow3 as integer
Dim i As Integer

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
ws1.Activate
lastrow1 = Cells(Rows.Count, 2).End(xlUp).Row
ws2.Activate
lastrow2 = Cells(Rows.Count, 3).End(xlUp).Row

If lastrow1 <> lastrow2 Then
MsgBox ("number of rows in Sheet1 is not equal to number of rows in Sheet2")
End If

For i = 2 To lastrow1
If ws1.Cells(i, 2) <> ws2.Cells(i, 3) Then
ws2.Cells(i, 3).Copy
Worksheets("Sheet3").Activate

lastrow3 = Cells(Rows.Count, 1).End(xlUp).Row
Cells(lastrow3, 1).Offset(1, 0).Activate
ActiveSheet.Paste
Cells(lastrow3, 1).Offset(1, 1) = "incorrect value"


End If
ws1.Activate

Next i
End Sub

Answer 2

Вам нужно только установить последнюю строку для sheet1 и sheet3.выполните цикл от 2 до последней строки и сравните Sheet1.columnB с Sheet2.columnC, если <>, затем скопируйте значение в Sheet1 в Sheet3, сместите одну ячейку вправо и вставьте текст.Вы добавляете +1 к последнему ряду в Sheet3, чтобы не переписывать одну и ту же ячейку ...

Dim i As Long
Dim lRow As Long
lRow = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row

Dim lRow3 As Long
lRow3 = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row

    For i = 2 To lRow
        If Sheet1.Cells(i, "B").Value <> Sheet2.Cells(i, "C").Value Then
            Sheet3.Cells(lRow3, "A").Value = Sheet1.Cells(i, "B").Value
            Sheet3.Cells(lRow3, "A").Offset(, 1).Value = "Incorrect Value."
        End If
        lRow3 = lRow3 + 1
    Next i