Двойное выделение

Sub sortt()
' Функция поиска двойных денежных потоков
Application.ScreenUpdating = False
    ActiveWorkbook.Worksheets("Общая ОСВ").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Общая ОСВ").AutoFilter.Sort.SortFields.Add Key:= _
        Range("F5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Общая ОСВ").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
For i = 6 To ActiveSheet.Cells.SpecialCells(xlLastCell).Row
  If Range("F" & i) = Range("F" & i + 1) And Range("D" & i)  Range("D" & i + 1) Then
     Range("B" & i & ":M" & i + 1).Select  'заменить на эту строку
       With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent6
            .TintAndShade = 0.599993896298105
            .PatternTintAndShade = 0
       End With
      i = i + 2 'b 'и это добавить
   Else
      Range("B" & i & ":M" & i).Select
       With Selection.Font
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
       End With
       
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
       End With
       
  End If
Next i

    ActiveWorkbook.Worksheets("Общая ОСВ").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Общая ОСВ").AutoFilter.Sort.SortFields.Add Key:= _
        Range("A3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Общая ОСВ").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Application.ScreenUpdating = True
End Sub

Добавить комментарий

Ваш адрес email не будет опубликован.