Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Автоматическая сортировка по нескольким условиям (VBA)
 
#1
24.04.2017 18:47:05
Здравствуйте!

Нужна помощь для реализации автоматической сортировки по нескольким условиям (VBA):
1. Максимальное значение в столбце E для первой строки группы.
2. Сортировка по убыванию в рамках группы.
3. При равных значениях первых строк в столбце E, первой выводится наиболее многочисленная группа.
4. Если все условия в пункте 3 равны, то данные должны сортироваться по алфавиту в рамках первых двух условий.

Заранее благодарю.
Пример сортировки:
 
 
 
#2
24.04.2017 20:01:48
Цитата
AB1 написал: в рамках группы.
значит надо ввести идентификатор для группы... и сортировать, как описали (по очереди)
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#3
24.04.2017 20:55:10
Желательный порядок сортировки указываем в столбце H листа calc H1:H7 (H1-цвет, H2- существительное, и т.д. H7- буква)
Код
Sub GroupSort()
Dim iIndex As Integer
    Application.AddCustomList ListArray:=Range("H1:H7")
      iIndex = Application.GetCustomListNum(Range("H1:H7").Value)
    Range("C2:F13").Sort Key1:=Range("E2"), Order1:=xlDescending, Header:=xlNo, _
                    Orientation:=xlSortColumns
    Range("C2:F13").Sort Key1:=Range("F2"), Order1:=xlAscending, Header:=xlNo, _
                    Orientation:=xlSortColumns, OrderCustom:=iIndex + 1
    Application.DeleteCustomList iIndex
End Sub
 
 
 
#4
25.04.2017 11:15:17
Большое спасибо за помощь, вечером попробую!
 
 
 
#5
26.04.2017 13:03:35
Цитата
JeyCi написал:
значит надо ввести идентификатор для группы
Подскажите, пожалуйста, как это сделать?
 
 
 
#6
26.04.2017 13:24:52
Kuzmich
Компилятор выдает ошибку:

Точно ли проблема связана с копированием кода?
 
 
 
#7
26.04.2017 13:29:53
Я писал,что порядок сортировки указываем в столбце H листа calc H1:H7 (H1-цвет, H2- существительное, и т.д. H7- буква).
У вас в примере этого списка нет
 
 
 
#8
26.04.2017 13:51:46
Kuzmich
Спасибо, исправил, все работает.
Только немного по-другому.
Алгоритм должен быть таким:

В рамках каждой группы выявляются строки с максимальным значением суммы символов.
Затем определяется количество строк в каждой группе.
Затем, строки-победители в каждой группе сравниваются между собой по максимальному значению суммы символов.
Затем, выводится группа-победитель с сортировкой по убыванию значений суммы символов.
Затем, выводятся остальные группы с такой же сортировкой.

Кроме этого, учитываются следующие правила:

3. При равных значениях первых строк в столбце E, первой выводится наиболее многочисленная группа.
4. Если все условия в пункте 3 равны, то данные должны сортироваться по алфавиту в рамках первых двух условий.
Изменено: AB1 - 26.04.2017 13:52:49
 
 
 
#9
26.04.2017 14:05:52
Вы на вашем примере покажите, как должен выглядеть результат сортировки
 
 
 
#10
26.04.2017 14:09:57
В первом посте вложен файл с примером:

sample_5.xlsm
 
 
 
#11
26.04.2017 14:17:17
Так макрос так и отсортировал вашу таблицу
 
 
 
#12
26.04.2017 14:31:34
Возможно, я что-то делаю не так.
Сейчас макрос сортирует в том порядке, в котором расположены группы в столбце H.
 
 
 
#13
26.04.2017 14:44:56
Макрос предполагает список не повторяющихся значений в столбце H
 
 
 
#14
26.04.2017 15:33:17
Различия:
 
 
 
#15
26.04.2017 16:17:12
Вы измените порядок слов в столбце H на требуемый вам порядок сортировки
буква
транспорт
глагол
люди
существительное
цвет
прочее
 
 
 
#16
26.04.2017 17:00:46
Порядок сортировки определяется правилами: сейчас он один, в след. раз будет другим.
Название группы не влияет на порядок сортировки напрямую, только с учетом правил.
 
 
 
#17
26.04.2017 17:41:01
А так попробуйте, если я правильно понял
Код
Sub GroupSort()
Dim iIndex As Integer
Dim i As Integer
Dim FoundGroup As Range
    Range("C2:F13").Sort Key1:=Range("E2"), Order1:=xlDescending, Header:=xlNo, _
                    Orientation:=xlSortColumns
  For i = 1 To Cells(Rows.Count, "H").End(xlUp).Row
    Set FoundGroup = Columns("F").Find(Cells(i, "H"), , xlValues, xlWhole)
      Cells(i, "G") = FoundGroup(, 0)
  Next
     Range("G1:H" & Cells(Rows.Count, "H").End(xlUp).Row).Sort Key1:=Range("G1"), _
                                               Order1:=xlDescending, Header:=xlNo
    Application.AddCustomList ListArray:=Range("H1:H7")
      iIndex = Application.GetCustomListNum(Range("H1:H7").Value)
    Range("C2:F13").Sort Key1:=Range("F2"), Order1:=xlAscending, Header:=xlNo, _
                    Orientation:=xlSortColumns, OrderCustom:=iIndex + 1
    Application.DeleteCustomList iIndex
End Sub
 
 
 
#18
26.04.2017 18:45:56
Спасибо, сортирует корректно, но статичные значения максимальных величин, соответствующие определенной группе (используемые в примере в диапазоне G1-G7), рассчитываются динамически в столбце E. Возможно ли определять данные значения (G1-G7) из столбца E при помощи макроса?
 
 
 
#19
26.04.2017 19:20:37
Цитата
Возможно ли определять данные значения (G1-G7) из столбца E при помощи макроса?
Последний макрос (сообщение #17)  так и работает
 
 
 
#20
26.04.2017 19:45:09
Тогда все идеально!
Благодарю вас!
 
 
 
#21
26.04.2017 19:53:42
Но этот макрос надо интегрировать в первый макрос
 
 
 
#22
27.04.2017 10:42:30
Я не программист, объединил интуитивно, вроде работает:
Код
Sub iWords()
Dim i As Long
Dim iLastRow As Long
Dim n As Integer
Dim j As Integer
Dim iIndex As Integer
Dim k As Integer
Dim FoundGroup As Range
Dim MyArr
   iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
 With CreateObject("scripting.dictionary"): .comparemode = 1
  n = 2
  For i = 2 To iLastRow
      MyArr = Split(Cells(i, "A"), " ")
    For j = 0 To UBound(MyArr)
     If Not .exists(MyArr(j)) Then  'если нет слова, то добавляем его в словарь и в столбец B
      .Add MyArr(j), 1
      Cells(n, "C") = MyArr(j)
      n = n + 1
     End If
    Next
  Next
 End With
   iLastRow = Cells(Rows.Count, "C").End(xlUp).Row
   Range("C1:C" & iLastRow).Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlYes
    Range("C2:F14").Sort Key1:=Range("E2"), Order1:=xlDescending, Header:=xlNo, _
                    Orientation:=xlSortColumns
  For k = 1 To Cells(Rows.Count, "H").End(xlUp).Row
    Set FoundGroup = Columns("F").Find(Cells(k, "H"), , xlValues, xlWhole)
      Cells(k, "G") = FoundGroup(, 0)
  Next
     Range("G1:H" & Cells(Rows.Count, "H").End(xlUp).Row).Sort Key1:=Range("G1"), _
                                               Order1:=xlDescending, Header:=xlNo
    Application.AddCustomList ListArray:=Range("H1:H7")
      iIndex = Application.GetCustomListNum(Range("H1:H7").Value)
    Range("C2:F14").Sort Key1:=Range("F2"), Order1:=xlAscending, Header:=xlNo, _
                    Orientation:=xlSortColumns, OrderCustom:=iIndex + 1
    Application.DeleteCustomList iIndex
    
End Sub
Изменено: AB1 - 27.04.2017 10:44:06
 
 
 
#23
27.04.2017 10:46:45
Возможно, нужно убрать первую сортировку, но требуется время, чтобы разобраться :)  
 
 
 
Страницы: 1
Читают тему
Наверх