Страницы: 1
RSS
Сортировка/фильтрация ячеек вне умной таблицы
 
Добрый день!

Суть проблемы: при применении фильтра (сортировка) в таблице не происходит сортировка ячеек за пределами таблицы.
В примере: верхняя таблица - было; нижняя таблица - после применения сортировки (в таблице порядок изменился; за пределами изменений нет) .
Может есть решение в виде применения сочетания клавиш или же здесь решение требует кардинального вмешательства.
 
Рустем, странная у Вас потребность.
Данные за пределами умной таблицы и НЕ должны сортироваться при сортировке таблицы.
Если нужна сортировка и других данных, почему просто не расширить таблицу?
 
Сортировать одновременно и данные умной таблицы и данные за её пределами стандартными средствами не получится, потому что данные за пределами таблицы никак не связаны с самой таблицей. Только костыли всякие не очень удобные(а-ля макрос и т.п.) или двойная сортировка(сначала данные таблицы, потом данные вне таблицы).
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Спасибо за ответы.

Надобность - просто с точки зрения простоты и удобства: часто необходимо написать пояснение для себя отдельно от таблицы, к этим пояснениям еще какие-то пояснения или прикидочные инженерные расчеты.

Значит будем внимательней при применении фильтра.
 
Код
Option Explicit

Const EXTRA_COLUMNS_COUNT = 2
Const SORT_COLUMN_INDEX = 2

Sub SortTableExtraRange()
    Dim tb As ListObject
    Set tb = GetListObject(ActiveCell)
    If Not tb Is Nothing Then
        Dim tb_Columns_Count As Long
        tb_Columns_Count = tb.DataBodyRange.Columns.Count
        Dim rSort As Range
        Set rSort = tb.DataBodyRange.Resize(, tb_Columns_Count + EXTRA_COLUMNS_COUNT)
        
        Application.ScreenUpdating = False
        
        SortRange rSort
        RestoreListObject tb, tb_Columns_Count
        
        Application.ScreenUpdating = True
        
    End If
End Sub

Sub RestoreListObject(tb As ListObject, tb_Columns_Count As Long)
    tb.Resize tb.Range.Resize(, tb_Columns_Count)
End Sub

Sub SortRange(rSort As Range)
    Dim arr As Variant
    arr = rSort
    
    Dim rn As Range
    Set rn = Workbooks.Add(1).Sheets(1).Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2))
    rn.Value = arr
    
    With rn.Parent.Sort
        .SortFields.Clear
        .SortFields.Add Key:=rn.Columns(SORT_COLUMN_INDEX), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SetRange rn
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    arr = rn
    rn.Parent.Parent.Close False
    rSort = arr
End Sub

Function GetListObject(cl As Range) As ListObject
    Dim tb As ListObject
    For Each tb In cl.Parent.ListObjects
        If Not Intersect(tb.Range, cl) Is Nothing Then
            Set GetListObject = tb
            Exit Function
        End If
    Next
End Function
 
МатросНаЗебре, благодарю!
Изменено: Рустем - 14.01.2022 11:06:34
Страницы: 1
Читают тему (гостей: 1)
Наверх