У меня есть 2 листа с одним офлайн-данными и одним онлайн-данными с сервера БД, и я хочу отсортировать разницу между двумя листами, выделить разницу, подсчитать разницу и отобразить значение подсчета в конечном столбце, если оно есть еще должен сказать "то же самое" в конце столбца.
Например: лист 1
A B C D
T1 T2 T3 T4
T1 T2 T3 T4
Лист 2
A B C D
T1 T2 T3 T4
T1 T2 T4 T5
Результат -> лист 3 должен быть
A B C D E
T1 T2 T3 T4
T1 T2 T3 T4 Same
T1 T2 T3 T4
T1 T2 T4 T5 2 difference
Код, который у меня есть, выделяет разницу, но не вставляет значение Листа 1 в Лист 3. Конечным результатом будет сравнение той же строки и ячейки между Листом 1 и Листом 2, и нужно вставить разницу в листе 3 с помощью вставлять оба ряда подряд. Любая помощь высоко ценится.
Sub Compare()
Dim ColumnCount, RowCount As Long
Dim w As Worksheet, r As Range
'Clearing the contents of the third sheet for the fresh comparison
usedCoulms = ThisWorkbook.Worksheets("Sheet4").UsedRange.Columns.Count
usedRows = ThisWorkbook.Worksheets("Sheet4").UsedRange.Rows.Count
For i = 1 To usedRows
For j = 1 To usedCoulms
Sheets("Sheet4").Cells(i, j).Value = ""
Sheets("Sheet4").Cells(i, j).Interior.Color = RGB(255, 255, 255)
Next
Next
'Coulmn count of first sheet
ColumnCount = ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns.Count
'row count of first sheet
RowCount = ThisWorkbook.Worksheets("Sheet1").UsedRange.Rows.Count
For i = 1 To RowCount
For j = 1 To ColumnCount
If Sheets("Sheet1").Cells(i, j).Value <> Sheets("Sheet2").Cells(i, j).Value Then 'Comparing if values are not equal
Sheets("Sheet4").Cells(i, j).Value = Sheets("Sheet1").Cells(i, j).Value 'Copying the Header of the Mismatched Cell
Sheets("Sheet4").Cells(i, j).Value = Sheets("Sheet2").Cells(i, j).Value 'CStr("MisMatch") 'If mismatch setting set value as MisMatch
Sheets("Sheet4").Cells(i, j).Interior.Color = 65535 'Highlighting with Yellow color
Else
Sheets("Sheet4").Cells(i, j).Value = Sheets("Sheet2").Cells(i, j).Value
'If values are same copy the first sheets value if dont want to copy can skip this
End If
Next
Next
MsgBox "SORTINGCOMPLETE"
End Sub