Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Сортировка в "умных таблицах", Сортировка в нескольких "умных таблицах" в книге одним макросом
 
#1
28.03.2017 06:33:12
Добрый день! Нужен совет. Есть множество листов, на каждом есть умная таблица (именованый диапазон). Сделал код который должен сортировать таблицу в зависимости на каком листе находится и определяя название диапазона при помощи переменной, но ... не выходит каменный цветок. Ругается при сортировке, в чём ошибка? Подскажите
Код
Sub Макрос4()
    Dim iSource As ListObject
    Set iSource = ActiveCell.ListObject
    If iSource Is Nothing Then Exit Sub

    ActiveWorkbook.ActiveSheet.ListObjects(iSource).Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.ListObjects(iSource).Sort.SortFields.Add _
        Key:=Range("A:A"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.ListObjects(iSource).Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
 
 
 
#2
28.03.2017 08:40:39
Код
Sub Макрос1()
    With ActiveWorkbook.Worksheets("Лист2").ListObjects("Таблица_main1.DB3")
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.ListColumns("date_priem").Range, SortOn _
        :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.Header = xlYes
        .Sort.MatchCase = False
        .Sort.Orientation = xlTopToBottom
        .Sort.SortMethod = xlPinYin
        .Sort.Apply
    End With
End Sub
 
 
 
#3
28.03.2017 08:56:21
В этом вся суть, ув. RAN, нет у меня возможности прописать для каждой таблицы (их порядка 50 шт) свой макрос. Вот я и пробовал через переменную
Код
Dim iSource As ListObject    
Set iSource = ActiveCell.ListObject
С одинокой таблицей у меня проблем нет (спасибо макрорекордеру :) ), а вот что бы с несколькими десятками, да одним макросом...
 
 
 
#4
28.03.2017 09:03:54
Макрос из поста #2 преобразуется в макрос, обрабатывающий ВСЕ таблицы в книге, примерно за 5 минут.  ;)
 
 
 
#5
28.03.2017 09:21:26
Эээ...не понял, а поподробнее...
 
 
 
#6
28.03.2017 09:24:23
Код
Sub qq()
    Dim sh As Worksheet, ListObj As Object, ListCol As Object, sOrder As Long
    sOrder = 1
    For Each sh In Worksheets
        For Each ListObj In sh.ListObjects
            Set ListCol = ListObj.ListColumns(1)
            Call ww(ListObj, ListCol, sOrder)
        Next
    Next
End Sub
Sub ww(ListObj As Object, ListCol As Object, sOrder As Long)
    With ListObj.Sort
        .SortFields.Clear
        .SortFields.Add Key:=ListCol.Range, SortOn _
        :=xlSortOnValues, Order:=sOrder, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
 
 
 
#7
28.03.2017 09:50:30
...а для активного (выбранного) листа?..
кажется так
Код
Sub qq()
    Dim sh As Worksheet, ListObj As Object, ListCol As Object, sOrder As Long
    Set ListObj = ActiveCell.ListObject
    sOrder = 1
'    For Each sh In Worksheets
'        For Each ListObj In sh.ListObjects
            Set ListCol = ListObj.ListColumns(1)
            Call ww(ListObj, ListCol, sOrder)
'        Next
'    Next
End Sub
Sub ww(ListObj As Object, ListCol As Object, sOrder As Long)
    With ListObj.Sort
        .SortFields.Clear
        .SortFields.Add Key:=ListCol.Range, SortOn _
        :=xlSortOnValues, Order:=sOrder, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Спс. Андрей Николаевич...получилось!

Изменено: QwertyBoss - 28.03.2017 10:01:13
 
 
 
Страницы: 1
Наверх