Проверка разницы между двумя листами и выделение разницы в колонке с надписью «Разница»? - PullRequest
0 голосов
/ 16 ноября 2018

У меня есть 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

1 Ответ

0 голосов
/ 14 января 2019

Я думаю, что было бы лучше и проще иметь все данные на одном листе, потому что вы сравниваете всегда одни и те же строки на обоих листах. Итак, я сделал это:

enter image description here

Вы сравниваете строку 2 листа 1 со строкой 2 листа 2, строку 3 с строкой 3 и т. Д. ...

Тогда в столбце оценки у меня есть эта формула:

=IF(4-SUMPRODUCT(--(A2:D2=F2:I2))>0;4-SUMPRODUCT(--(A2:D2=F2:I2))&" difference";"same")

Как видите, первое сравнение возвращает same, потому что нет различий. Второе сравнение (строка 3) возвращает 2 difference, потому что есть только 2 совпадения.

Чтобы выделить оценку, просто правило условного форматирования. Если текст содержит слово difference, выделите его.

Надеюсь, вы сможете приспособить это к вашим потребностям.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...