Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Как убрать выделение после сортировки на неактивном листе. VBA
 
#1
12.12.2019 11:26:34
Здравствуйте, в примере на Листе1, если нажать Sort2, произойдет сортировка на неактивном Листе2, при этом выделяется первая строка диапазона. Аналогично на Листе2, если нажать Sort1, произойдет сортировка на неактивном Листе1 и будет выделен весь диапазон. Возможно ли сделать так, чтобы при сортировке на неактивном листе никаких выделений не происходило?

Код
Sub Sort1()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim Sh As Range, iLastRow&
iLastRow& = Cells(ActiveWorkbook.Worksheets("Ëèñò1").Rows.Count, 8).End(xlUp).Row
iLastRow& = IIf(iLastRow < 5, 5, iLastRow)
    ActiveWorkbook.Worksheets("Ëèñò1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Ëèñò1").Sort.SortFields.Add Key:=Range("D5:D" & iLastRow), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Ëèñò1").Sort
        .SetRange Range("B5:H" & iLastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Код
Sub Sort2()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim Sh As Range, iLastRow&
iLastRow& = Cells(ActiveWorkbook.Worksheets("Ëèñò2").Rows.Count, 9).End(xlUp).Row
iLastRow& = IIf(iLastRow < 5, 5, iLastRow)
    ActiveWorkbook.Worksheets("Ëèñò2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Ëèñò2").Sort.SortFields.Add Key:=Range("D5:D" & iLastRow), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Ëèñò2").Sort
        .SetRange Range("B5:I" & iLastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Изменено: Hashtag - 12.12.2019 11:27:26
 
 
 
#2
12.12.2019 11:34:59
Код
Sub Sort2()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim Sh As Range, iLastRow&
iLastRow& = Cells(ActiveWorkbook.Worksheets("Лист2").Rows.Count, 9).End(xlUp).Row
iLastRow& = IIf(iLastRow < 5, 5, iLastRow)
        
    Dim ActiveSheetName As String
    Dim r As Range
    ActiveSheetName = ActiveSheet.Name
    
    With ActiveWorkbook.Worksheets("Лист2").Sort
        .Parent.Select
        Set r = Selection
        
        .SortFields.Clear
        .SortFields.Add Key:=Range("D5:D" & iLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("B5:I" & iLastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        r.Select
    End With
    Worksheets(ActiveSheetName).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
 
 
 
#3
12.12.2019 11:50:34
МатросНаЗебре
В вашем варианте сортировка происходит только на активном листе, а нужно чтобы сортировался диапазон и у неактивного листа, но без выделения диапазона.
 
 
 
#4
12.12.2019 12:07:59
В предложенном варианте после работы макроса возвращается выделение, которое было на сортируемом листе, независимо от того, является ли сортируемый лист активным или нет на момент запуска макроса. Как бы предполагалось, что изменения в Sort1 Вы осилите.
 
 
 
#5
12.12.2019 12:13:53
Sort1 я осилю. На активном Листе1 я активирую ваш макрос Sort2 кнопкой Sort2, но на Листе2 сортировка не происходит.
 
 
 
#6
12.12.2019 13:29:30
Цитата
Hashtag написал:
но на Листе2 сортировка не происходит.
А без моего кода происходит?
 
 
 
#7
12.12.2019 13:33:32
Код
iLastRow& = Cells(ActiveWorkbook.Worksheets("Лист2").Rows.Count, 9).End(xlUp).Row
Думаю проблема в этой строке. Нужно 9 заменить на число от 2 до 8.
 
 
 
#8
12.12.2019 13:47:27
МатросНаЗебре
Прошу прощения,  вы правы. Только сейчас заметил, мой код сортирует только на активном листе. Замена 9 на число от 2 до 8 не помогает, если заполнено много строк. Проблема в сортировке на неактивном листе.
Изменено: Hashtag - 12.12.2019 13:48:45
 
 
 
#9
12.12.2019 13:53:52
Код
Sub Sort1()
  Sort "Лист1", 8
End Sub
 
 
Sub Sort2()
  Sort "Лист2", 9
End Sub


Sub Sort(ShNm$, C&)
  Dim rg As Range, ws
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  If ShNm = ActiveSheet.Name Then
    Set rg = ActiveCell
  Else
    Set ws = ActiveSheet: Worksheets(ShNm).Activate: Set rg = ActiveCell
    ws.Activate
  End If
  Dim Sh As Range, iLastRow&
  With ActiveWorkbook.Worksheets(ShNm)
    iLastRow& = .Cells(.Rows.Count, C).End(xlUp).Row
    If iLastRow < 5 Then Exit Sub
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=.Range("D5:D" & iLastRow), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      .Sort.SetRange .Range("B5:" & Left(Cells(1, C).Address(0, 0), 1) & iLastRow)
    With .Sort
      .Header = xlGuess: .MatchCase = False
      .Orientation = xlTopToBottom: .SortMethod = xlPinYin: .Apply
    End With
  End With
  If rg.Parent.Name = ActiveSheet.Name Then
    rg.Select
  Else
    Worksheets(ShNm).Activate: rg.Select: ws.Activate
  End If
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub
Изменено: Ігор Гончаренко - 12.12.2019 14:24:59
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#10
12.12.2019 14:13:20
Ігор Гончаренко
Спасибо, ваше решение работает. Подскажите, что нужно изменить в вашем коде в случае, если листы называются произвольно и без номера (Склад, Цех и т.д.)?
 
 
 
#11
12.12.2019 14:27:33
исправил немного
при вызове Sort передавайте ей ИмяЛиста и №ПоследнейКолонки с данными на этом листе
в примере показано как
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#12
12.12.2019 14:37:26
Ігор Гончаренко
Да, все работает, как надо. Спасибо огромное!
 
 
 
Страницы: 1
Наверх