Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Сортировка макросом по двум условиям
 
#1
06.05.2018 01:27:23
Здравствуйте.
В примере список. Необходимо отсортировать, сначала по наименованию, затем по размеру.
На макрорекордер меня конечно хватило (сделал настраиваемое правило), но к сожалению стандартная сортировка несмотря на все мои указания сводит размеры начинающиеся на X рядом.
Изменено: Novichok55 - 06.05.2018 19:50:48
 
 
 
#2
06.05.2018 06:09:53
А макрос обязательно? Обычной сортировкой решение не устроит?
Первый уровень сортировки по наименованию от А до я. А второй уровень сделайте по настраиваемому списку. Подробности можете читать здесь https://support.office.com/ru-ru/article/%D0%A1%D0%BE%D1%80%D1%82%D0%B8%D1%80%D0%BE%D0%B2%­D0%BA%D0%B...
Если автоматизировать бардак, то получится автоматизированный бардак.
 
 
 
#3
06.05.2018 06:58:03
wowick
так и делал согласно этой статьи, но как я уже написал
Цитата
Novichok55 написал:
На макрорекордер меня конечно хватило (сделал настраиваемое правило), но к сожалению стандартная сортировка несмотря на все мои указания сводит размеры начинающиеся на X рядом.
 
 
 
#4
06.05.2018 07:36:22
Цитата
Novichok55 написал:
ак и делал согласно этой статьи, но как я уже написал
Так вот я у себя тоже проверил, и не работает. Вместо упорядочения согласно созданного списка, оно почему то сортирует по алфавиту. Хотя встроенная сортировка по дням недели работает... У меня Офис2010.
Если автоматизировать бардак, то получится автоматизированный бардак.
 
 
 
#5
06.05.2018 09:06:17
По второму условию сортирует тоже, за исключением бага по X (точнее повторяющейся первой буквы в размере для одного наименования), тут оно как-то по другому начинает думать и все X рядышком ставит (кстати в порядке возрастания, как и указано в правиле). Т.е. если X одна для отдельно взятого наименования, то бага Excel можно и не заметить, всё выстроится.
Изменено: Novichok55 - 06.05.2018 09:22:01
 
 
 
#6
06.05.2018 10:52:51
 
 
 
#7
06.05.2018 12:01:20
Да, к сожалению, я привел пример в котором работает :( очень неловко.
Щяс попытаюсь сделать такой как у меня в котором не работает. Просто оригинал не могу прямо выложить :(
Изменено: Novichok55 - 06.05.2018 18:47:34
 
 
 
#8
06.05.2018 18:47:41
Anchoret
"поправил",  в первом сообщении нужный файл, оказывается не всё так просто, в нужном  порядке необходимо раскидать по списку, чтоб не сработало.
Ещё раз извините за отнятое время.
 
 
 
#9
06.05.2018 19:27:02
Уважаемый Novichok55! У меня (Excel 2007, Excel 2016) сортировка выполняется правильно. Будьте внимательны при формировании пользовательского списка: лучше всего его скопировать из предварительно подготовленного диапазона ячеек. Нужно перечислять все возможные значения ячеек полностью (а не первые буквы, знаки подстановок типа "*" не работают). Если Вы какие-то значения ячеек пропустите, то в начале отсортированного поля будут значения из Вашего списка, а затем - значения, не указанные в списке, по алфавиту. Успехов!
Изменено: sokol92 - 06.05.2018 19:27:47
Владимир
 
 
 
#10
06.05.2018 19:49:25
sokol92
У меня тоже 2007.

Стабильно, не срабатывает. В т.ч. если одно условие только дать, хотя это будет не корректно только по одному для моего случая с куда большим списком.
У  Anchoret хватило и одного условия благодаря моему первому неудачному примеру.
Не знаю, что я ещё могу сделать. Не важно сверху вниз размеры будут возрастать или снизу вверх, но чтоб X рядом все не ставило, XS и XL должны быть на разных полюсах отдельно взятого наименования.
Изменено: Novichok55 - 06.05.2018 20:03:11
 
 
 
#11
06.05.2018 20:19:12
Уважаемый Novichok55! Сравните значения ячеек в столбце B с элементами в Вашем настраиваемом списке: они не пересекаются! В Вашем списке, например, "XS", а нужно: "XS-2", "XS-5", "XS-8"...
В приведенном на картинке примере строки отсортированы в начале по значениям из столбца A, а затем - по значениям из столбца B по алфавиту, поскольку ни одного из значений ячеек столбца B нет в настраиваемом списке. Все стабильно.
Изменено: sokol92 - 06.05.2018 20:24:52
Владимир
 
 
 
#12
06.05.2018 20:22:42
Цитата
sokol92 написал: Сравните значения ячеек в столбце B с ячейками в Вашем настраиваемом списке: они не пересекаются! В Вашем списке, например, "XS", а нужно: "XS-2", "XS-5", "XS-8"...
Да ну это конечно же не вариант, поэтому и просил макрос. Нужно некое сортировать по алфавиту A-Z, только алфавит придумываю я.
Сделал сортировку на другом этапе своего формирования, когда размеры не соеденены ещё с цифрами и всё OK. Обошел, но вопрос всё равно конечно это интересный.
Изменено: Novichok55 - 06.05.2018 20:27:59
 
 
 
#13
07.05.2018 00:06:24
Цитата
Novichok55 написал:
поэтому и просил макрос
Здесь также будут некоторые ограничения.
Если вы можете добавить дополнительный столбец, то попробуйте, может что-то будет (или не будет  :) ) из того:
Код
Option Explicit
Option Base 1

Sub drugaya_sortirovka()
Dim i As Long, j As Long, vim As Long
Dim znk As String
Dim raz1, raz2, razmer()
'Zdes' vvedite adres pervoy yacheyki v stolbtse, v kotorom budet otobrazhat'sya indeks sortirovki
Const yach As String = "B1" 'Vnimaniye, eto otnositel'noye polozheniye - eto ne obyazatel'no budet 'B1'

    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    
    'Sokhraneniye v massiv
    razmer = Selection.Value
    vim = UBound(razmer, 1)
    'Ekstraktsiya/Podmena/Konvertirovaniye
    For i = 1 To vim
        'Ekstraktsiya
        raz1 = Trim(Split(razmer(i, 1), "-", -1, 1)(0))
        'Podmena
        raz1 = Switch(raz1 = "XXXS", "A", raz1 = "XXS", "B", raz1 = "XS", "C", raz1 = "S", "D", raz1 = "M", "E", _
                        raz1 = "MX", "F", raz1 = "L", "G", raz1 = "XLS", "H", raz1 = "XL", "I", raz1 = "XXL", "J", _
                        raz1 = "XXXL", "K", raz1 = "XXXXL", "L")
        'Ekstraktsiya
        raz2 = Trim(Split(razmer(i, 1), "-", -1, 1)(1))
        'Podmena
        For j = 1 To Len(raz2)
            znk = Mid(raz2, j, 1)
            Mid(raz2, j, 1) = Switch(znk = "0", "a", znk = "1", "b", znk = "2", "c", znk = "3", "d", znk = "4", "e", _
                                        znk = "5", "f", znk = "6", "g", znk = "7", "h", znk = "8", "i", znk = "9", "j")
        Next
        'Konvertirovaniye
        razmer(i, 1) = raz1 & raz2
    Next
    'Sortirovka
    With Selection
        'Vnimaniye - 'Range(yach)' - polozheniye otnositel'no pomechaniya - eto ne obyazatel'no budet 'B1'
        .Range(yach).Resize(vim, 1).Value = razmer
        Erase razmer
        With .CurrentRegion
            With .Cells(1)
                .Select
                .Sort Key1:=.Offset(1, 0), Order1:=xlAscending, Key2:=.Offset(1, 2), Order2:=xlAscending, Header:=xlYes
            End With
        End With
    End With
    
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub
 
 
 
#14
08.05.2018 21:39:51
Спасибо. В принципе вроде как работает. Единственное ограничение немного раздражает, что нужно обязательно над размерами в первой строке создать ячейку с каким-нибудь словом :(
 
 
 
#15
09.05.2018 05:03:12
Можете удалить строку заголовка, заблокировать (как ниже, закомментировать эту строку) сортировку и выполнить её вручную после завершения макроса ... ну, только, как это ... таблица без заголовков ? Это как солдат без обуви ... всё хромает ... : /
Код
'Sortirovka
    With Selection
        .Range(yach).Resize(vim, 1).Value = razmer
        Erase razmer
        With .CurrentRegion
            With .Cells(1)
                .Select
    '            .Sort Key1:=.Offset(1, 0), Order1:=xlAscending, Key2:=.Offset(1, 2), Order2:=xlAscending, Header:=xlYes
            End With
        End With
    End With
 
 
 
#16
09.05.2018 10:13:00
Да тут дело в том, что это все на промежуточном этапе моей задумки происходит  :sceptic:  
 
 
 
#17
09.05.2018 15:45:32
Ну, что ж, так когда "идеи будут скристаллизоваными", люди помогут на форуме, думаю.
На данный момент, замените предыдущий код на приведенный ниже, вы сможете сортировать (автоматически, макросам) без заголовков и в любой части рабочего листа. Только, должны быть разрывы одной строки и одной колонки вокруг таблицы, чтобы код правильно распознал "CurrentRegion" (текущая область таблицы).
Код
    'Sortirovka
    With Selection
        'Vnimaniye - 'Range(yach)' - polozheniye otnositel'no pomechaniya - eto ne obyazatel'no budet 'B1'
        .Range(yach).Resize(vim, 1).Value = razmer
        Erase razmer
        With .CurrentRegion
            With .Cells(1)
                .Select
                '.Sort Key1:=.Offset(1, 0), Order1:=xlAscending, Key2:=.Offset(1, 2), Order2:=xlAscending, Header:=xlYes
                .Sort Key1:=.Offset(0, 0), Order1:=xlAscending, Key2:=.Offset(0, 2), Order2:=xlAscending, Header:=xlNo
            End With
        End With
    End With
 
 
 
#18
09.05.2018 20:25:05
Если честно говорить.
Я не понимаю, что это означает "Только, должны быть разрывы одной строки и одной колонки вокруг таблицы". Всё до чего я по этому выражению додумался, так это добавить в первую строку пустую строку, и в первый столбец пустой столбец, как бы оторвал свой пример от левого верхнего угла.
Сделал код на базе изначального, плюс те правки, что вы сделали
Код
Sub drugaya_sortirovka()
Dim i As Long, j As Long, vim As Long
Dim znk As String
Dim raz1, raz2, razmer()
'Zdes' vvedite adres pervoy yacheyki v stolbtse, v kotorom budet otobrazhat'sya indeks sortirovki
Const yach As String = "B1" 'Vnimaniye, eto otnositel'noye polozheniye - eto ne obyazatel'no budet 'B1'
 
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
     
    'Sokhraneniye v massiv
    razmer = Selection.Value
    vim = UBound(razmer, 1)
    'Ekstraktsiya/Podmena/Konvertirovaniye
    For i = 1 To vim
        'Ekstraktsiya
        raz1 = Trim(Split(razmer(i, 1), "-", -1, 1)(0))
        'Podmena
        raz1 = Switch(raz1 = "XXXS", "A", raz1 = "XXS", "B", raz1 = "XS", "C", raz1 = "S", "D", raz1 = "M", "E", _
                        raz1 = "MX", "F", raz1 = "L", "G", raz1 = "XLS", "H", raz1 = "XL", "I", raz1 = "XXL", "J", _
                        raz1 = "XXXL", "K", raz1 = "XXXXL", "L")
        'Ekstraktsiya
        raz2 = Trim(Split(razmer(i, 1), "-", -1, 1)(1))
        'Podmena
        For j = 1 To Len(raz2)
            znk = Mid(raz2, j, 1)
            Mid(raz2, j, 1) = Switch(znk = "0", "a", znk = "1", "b", znk = "2", "c", znk = "3", "d", znk = "4", "e", _
                                        znk = "5", "f", znk = "6", "g", znk = "7", "h", znk = "8", "i", znk = "9", "j")
        Next
        'Konvertirovaniye
        razmer(i, 1) = raz1 & raz2
    Next
    'Sortirovka
    With Selection
        'Vnimaniye - 'Range(yach)' - polozheniye otnositel'no pomechaniya - eto ne obyazatel'no budet 'B1'
        .Range(yach).Resize(vim, 1).Value = razmer
        Erase razmer
        With .CurrentRegion
            With .Cells(1)
                .Select
                '.Sort Key1:=.Offset(1, 0), Order1:=xlAscending, Key2:=.Offset(1, 2), Order2:=xlAscending, Header:=xlYes
                .Sort Key1:=.Offset(0, 0), Order1:=xlAscending, Key2:=.Offset(0, 2), Order2:=xlAscending, Header:=xlNo
            End With
        End With
    End With
     
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

запускаю, ругается на строку
Код
raz2 = Trim(Split(razmer(i, 1), "-", -1, 1)(1))
Изменено: Novichok55 - 09.05.2018 20:28:14
 
 
 
#19
09.05.2018 22:01:06
Цитата
Novichok55 написал:
Я не понимаю, что это означает "Только, должны быть разрывы одной строки и одной колонки вокруг таблицы".
Это значит, что обрабатываемая таблица должна быть "изолирована" от других таблиц ))
 
 
 
#20
10.05.2018 02:18:06
Цитата
Novichok55 написал:
что это означает "Только, должны быть разрывы
... вот и договорились ...  :)  ... россиянин с иноземцем через очередного россиянина ... хорошо, что мы не писали о женщинах, ой было бы ...  :)

Цитата
Novichok55 написал:
Сделал код на базе изначального
Код как ниже:
Код
Option Explicit
Option Base 1

Sub drugaya_sortirovka()
Dim i As Long, j As Long, vim As Long
Dim znk As String
Dim raz1, raz2, razmer()
Const yach As String = "B1" 'Vnimaniye, eto otnositel'noye polozheniye - eto ne obyazatel'no budet 'B1'

    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    
    'Sokhraneniye v massiv
    razmer = Selection.Value
    vim = UBound(razmer, 1)
    'Ekstraktsiya/Podmena/Konvertirovaniye
    For i = 1 To vim
        'Ekstraktsiya
        raz1 = Trim(Split(razmer(i, 1), "-", -1, 1)(0))
        'Podmena
        raz1 = Switch(raz1 = "XXXS", "A", raz1 = "XXS", "B", raz1 = "XS", "C", raz1 = "S", "D", raz1 = "M", "E", _
                        raz1 = "MX", "F", raz1 = "L", "G", raz1 = "XLS", "H", raz1 = "XL", "I", raz1 = "XXL", "J", _
                        raz1 = "XXXL", "K", raz1 = "XXXXL", "L")
        'Ekstraktsiya
        raz2 = Trim(Split(razmer(i, 1), "-", -1, 1)(1))
        'Podmena
        For j = 1 To Len(raz2)
            znk = Mid(raz2, j, 1)
            Mid(raz2, j, 1) = Switch(znk = "0", "a", znk = "1", "b", znk = "2", "c", znk = "3", "d", znk = "4", "e", _
                                        znk = "5", "f", znk = "6", "g", znk = "7", "h", znk = "8", "i", znk = "9", "j")
        Next
        'Konvertirovaniye
        razmer(i, 1) = raz1 & raz2
    Next
    'Sortirovka
    With Selection
        'Vnimaniye - 'Range(yach)' - polozheniye otnositel'no pomechaniya - eto ne obyazatel'no budet 'B1'
        .Range(yach).Resize(vim, 1).Value = razmer
        Erase razmer
        With .CurrentRegion
            With .Cells(1)
                .Select
                '.Sort Key1:=.Offset(1, 0), Order1:=xlAscending, Key2:=.Offset(1, 2), Order2:=xlAscending, Header:=xlYes
                .Sort Key1:=.Offset(0, 0), Order1:=xlAscending, Key2:=.Offset(0, 2), Order2:=xlAscending, Header:=xlNo
            End With
        End With
    End With
    
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub
Пс.: Можно бы выполнить сортировку не на листе, только в массиве, тогда вам не понадобится дополнительный столбец, но, пока что, вы сами не знаете, что хотите сделать с вашим проектом ... :  / ?

Цитата
Юрий М написал:
таблица должна быть "изолирована" от других таблиц ))
Юрий М, спасибо вам за понимание ...  :)  ... и за перевод с "гугловего" на русский ...  :)  
Изменено: ocet p - 10.05.2018 02:22:56
 
 
 
#21
10.05.2018 12:36:13
Novichok55, Вы напишите порядок размеров так, как это должно быть по возрастанию.
Вот болванка:
Код
МассивРазмеров = Array("СамыйМаленький","Побольше","ЕщеБольше",...,"СамыйБольшой")

Просто я не знаю всей линейки размеров, а в магазине им не доверяю и примеряю... :)
Если Вы предоставите такую информацию, то для размеров можно и список для маски на листе не делать.
Достаточно данный массив загнать в процедуру и просто пользоваться этой сортировкой.
Нарисовать такой код не проблема, но настораживает, что при таком количестве предоставленной информации вопрос еще не решен....
Цитата
ocet p написал:
Можно бы выполнить сортировку не на листе, только в массиве, тогда вам не понадобится дополнительный столбец
Можно сделать и так, а можно сделать частично так (второй вариант, на мой взгляд более универсален).
Частично, значит отсортировать в массиве только размеры, а потом доработать оставшиеся поля сортировкой от Excel.
Изменено: AAF - 10.05.2018 12:37:38
 
 
 
#22
10.05.2018 16:28:09
Цитата
AAF написал:
можно сделать частично
Можно, но, считаю что лучше всего сделать всё одним способом, например (этот массив):
Код
Option Explicit
Option Base 1

Sub drugaya_sortirovka_3()
Dim i As Long, j As Long, vim As Long
Dim znk As String
Dim raz1, raz2, razmer(), tmp1, tmp2, tmp3

    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    
    If Selection.Rows.Count < 2 Then Exit Sub
    If Selection.Columns.Count <> 2 Then Exit Sub
    
    razmer = Selection.Value 'Nado vybrat' dve kolonki: nazvaniye i razmer
    vim = UBound(razmer, 1)
    ReDim Preserve razmer(vim, 3) 'Dopolnitel'naya kolonka dlya indeksa sortirovki
    
    For i = 1 To vim
        raz1 = Trim(Split(razmer(i, 2), "-", -1, 1)(0))
        raz1 = Switch(raz1 = "XXXS", "A", raz1 = "XXS", "B", raz1 = "XS", "C", raz1 = "S", "D", raz1 = "M", "E", _
                        raz1 = "MX", "F", raz1 = "L", "G", raz1 = "XLS", "H", raz1 = "XL", "I", raz1 = "XXL", "J", _
                        raz1 = "XXXL", "K", raz1 = "XXXXL", "L")
        raz2 = Trim(Split(razmer(i, 2), "-", -1, 1)(1))
        For j = 1 To Len(raz2)
            znk = Mid(raz2, j, 1)
            Mid(raz2, j, 1) = Switch(znk = "0", "a", znk = "1", "b", znk = "2", "c", znk = "3", "d", znk = "4", "e", _
                                        znk = "5", "f", znk = "6", "g", znk = "7", "h", znk = "8", "i", znk = "9", "j")
        Next
        razmer(i, 3) = raz1 & raz2
    Next
    
    raz1 = Empty: raz2 = Empty
    'Sortirovka
    For i = 1 To vim - 1
        For j = i + 1 To vim
            If razmer(i, 1) & ";" & razmer(i, 3) > razmer(j, 1) & ";" & razmer(j, 3) Then
                tmp1 = razmer(j, 1)
                tmp2 = razmer(j, 2)
                tmp3 = razmer(j, 3)
                razmer(j, 1) = razmer(i, 1)
                razmer(j, 2) = razmer(i, 2)
                razmer(j, 3) = razmer(i, 3)
                razmer(i, 1) = tmp1
                razmer(i, 2) = tmp2
                razmer(i, 3) = tmp3
            End If
        Next
    Next
    
    tmp1 = Empty: tmp2 = Empty: tmp3 = Empty
    'Vstavka dannykh na liste
    Selection.Cells(1).Select
    Selection.Resize(vim, 2).Value = razmer 'Vstavka dannykh bez poslednego stolbtsa
    Erase razmer
    
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

Данные в листе "List2" это только информация, не участвуют в коде.

Так Novichok55 попробуйте, работает это или не работает для вас ...
 
 
 
#23
10.05.2018 20:51:43
AAF
Код
МассивРазмеров = Array("XXXS","XXS","XS","S","M","L","XL","XXL","XXXL")
Ocet_p загнал в код листа, работает, при чем похоже железно, без всяких заголовков.
Изменено: Novichok55 - 10.05.2018 21:42:13
 
 
 
#24
10.05.2018 23:44:30
Код с инфо #22 также, в любом месте листа ...  :)  ... но вы можете свободно это создавать / формировать ...  :)  ... всё для людей ...
 
 
 
#25
11.05.2018 20:48:31
Novichok55, я спрашивал про цифры после "-"
Просто в Вашем примере не встречается таких комбинаций, типа, S-1, S-2, S-10.
После сортировки они встанут так: S-1, S-10, S-2, если их оставить как текст, даже если сами размеры сортируются правильно.
Я посчитал, что их надо учесть как числа.
Код
Sub SortByList()
Dim aOrderSize, a, d As Object, aData(), x, i&, j&, k&
aOrderSize = Array("XXXS", "XXS", "XS", "S", "M", "L", "XL", "XXL", "XXXL")
j = 2 'номер столбца таблицы с размерами
Set d = CreateObject("Scripting.Dictionary"): d.CompareMode = 1
For k = LBound(aOrderSize) To UBound(aOrderSize): d(aOrderSize(k)) = Format(k, "000"): Next
With Cells(2, 2).CurrentRegion '.offset(1)'offset, если есть заголовки
  aData = .Value
  For i = 1 To UBound(aData)
    a = Split(aData(i, j), "-")
    If d.exists(a(0)) Then a(0) = d(a(0)) Else d(a(0)) = Format(k, "000"): a(0) = Format(k, "000"): k = k + 1
    If UBound(a) > 0 Then If IsNumeric(a(1)) Then a(1) = Format(a(1), "0000")
    aData(i, j) = Join(a, "-")
  Next
  If UBound(aOrderSize) - LBound(aOrderSize) + 1 < k - 1 Then
    ReDim Preserve aOrderSize(LBound(aOrderSize) To k - 1): k = LBound(aOrderSize)
    For Each x In d.keys
      If IsEmpty(aOrderSize(k)) Then aOrderSize(k) = x
    Next
  End If
  Application.ScreenUpdating = False
  .Value = aData: Erase aData
  .Sort Key1:=.Cells(1), Order1:=xlAscending, Key2:=.Cells(2), Order2:=xlAscending, Header:=xlNo
  aData = .Value
  For i = 1 To UBound(aData)
    a = Split(aData(i, j), "-"): a(0) = aOrderSize(a(0))
    If UBound(a) > 0 Then If IsNumeric(a(1)) Then a(1) = CLng(a(1))
    aData(i, j) = Join(a, "-")
  Next
  .Value = aData: Erase aData
  Application.ScreenUpdating = True
End With
End Sub

Цитата
ocet p написал:
Можно, но, считаю что лучше всего сделать всё одним способом, например (этот массив):
Да, в целом согласен, но порядок вмонтированной сортировки Excel и через операторы сравнения разные.
Это к тому, что при дальнейшей обработке данных об этом нужно знать, дабы не напороться на проблемы.
Поэтому выбор за пользователем, который будет юзать код.
Так же фактор скорости начинает иметь значение при длинных таблицах.
Изменено: AAF - 11.05.2018 20:57:05
 
 
 
#26
11.05.2018 22:37:55
AAF
спасибо. Работает. Уже две альтернативных сортировки в запасе :)
 
 
 
Страницы: 1
Наверх