Коллег, помогите сравнить два листа с таблицами. Лист S2 - эталон. Лист S1 - был отредактирован. Ели были внесены изменения в ячейках - макрос отлично справляется и выделяет цветом строку и ячейку с изменениями. Но если в таблицу на листе S1 была добавлена новая строка - получается хаус! Подскажите, как прикрутить вариант, если была добавлена новая строка, чтоб она тоже выделялась? [vba]
Код
Sub Сравнение() Dim i As Long, j As Long, a, b Dim t As Date Dim Cout_r As Variant t = Timer a = Sheets("S2").UsedRange Application.ScreenUpdating = False With Sheets("S1") b = .Range(.cells(1), .cells(UBound(a), UBound(a, 2))) For i = 1 To UBound(a) Cout_r = 1 For j = 1 To UBound(a, 2) If a(i, j) <> b(i, j) Then If Cout_r = 1 Then Cout_r = 2 .Rows(i).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent2 .TintAndShade = 0.599993896298105 .PatternTintAndShade = 0 End With End If .cells(i, j).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent5 .TintAndShade = 0.599993896298105 .PatternTintAndShade = 0 End With End If Next j Next i End With Application.ScreenUpdating = True Debug.Print Format(Timer - t, "#0.00") End Sub
[/vba]
Коллег, помогите сравнить два листа с таблицами. Лист S2 - эталон. Лист S1 - был отредактирован. Ели были внесены изменения в ячейках - макрос отлично справляется и выделяет цветом строку и ячейку с изменениями. Но если в таблицу на листе S1 была добавлена новая строка - получается хаус! Подскажите, как прикрутить вариант, если была добавлена новая строка, чтоб она тоже выделялась? [vba]
Код
Sub Сравнение() Dim i As Long, j As Long, a, b Dim t As Date Dim Cout_r As Variant t = Timer a = Sheets("S2").UsedRange Application.ScreenUpdating = False With Sheets("S1") b = .Range(.cells(1), .cells(UBound(a), UBound(a, 2))) For i = 1 To UBound(a) Cout_r = 1 For j = 1 To UBound(a, 2) If a(i, j) <> b(i, j) Then If Cout_r = 1 Then Cout_r = 2 .Rows(i).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent2 .TintAndShade = 0.599993896298105 .PatternTintAndShade = 0 End With End If .cells(i, j).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent5 .TintAndShade = 0.599993896298105 .PatternTintAndShade = 0 End With End If Next j Next i End With Application.ScreenUpdating = True Debug.Print Format(Timer - t, "#0.00") End Sub
Sub u_700() Application.ScreenUpdating = False a = Application.Match("ИТОГО", Range("b:b"), 0) - 1 For b = 5 To a 'с 5-ой до строки, где ИТОГО (не включая) c = Application.Match(Range("b" & b), Sheets("S2").Range("b:b"), 0) '=ПОИСКПОЗ( d = Application.IsNumber(c) '=ЕЧИСЛО If d Then For e = 3 To 34 'с 3-го до 34 столбца f = Cells(b, e).Offset(0, -1).Interior.Color If Cells(b, e) <> Sheets("S2").Cells(c, e) Then Cells(b, e).Interior.Color = 15652797 If f = 16777215 Then Range(Cells(b, 1), Cells(b, e - 1)).Interior.Color = 11389944 Else If f <> 16777215 Then Cells(b, e).Interior.Color = 11389944 End If Next Else Range("a" & b & ":ah" & b).Interior.Color = 15652797 End If Next Application.ScreenUpdating = False End Sub
[/vba]
[vba]
Код
Sub u_700() Application.ScreenUpdating = False a = Application.Match("ИТОГО", Range("b:b"), 0) - 1 For b = 5 To a 'с 5-ой до строки, где ИТОГО (не включая) c = Application.Match(Range("b" & b), Sheets("S2").Range("b:b"), 0) '=ПОИСКПОЗ( d = Application.IsNumber(c) '=ЕЧИСЛО If d Then For e = 3 To 34 'с 3-го до 34 столбца f = Cells(b, e).Offset(0, -1).Interior.Color If Cells(b, e) <> Sheets("S2").Cells(c, e) Then Cells(b, e).Interior.Color = 15652797 If f = 16777215 Then Range(Cells(b, 1), Cells(b, e - 1)).Interior.Color = 11389944 Else If f <> 16777215 Then Cells(b, e).Interior.Color = 11389944 End If Next Else Range("a" & b & ":ah" & b).Interior.Color = 15652797 End If Next Application.ScreenUpdating = False End Sub