Страницы: 1
RSS
Последовательная сортировка выбранного числового диапазона
 
Коллеги, добрый день

Подскажите, у меня есть 2 вида таблиц, данные в которых нужно отсортировать (см. приложение), но вручную это дико долго.
Автомакросер не спасает, т.к. при изменении числа столбцов или строк с данными он становится бесполезным.  Как создать макрос, чтобы в выделенном диапазоне он поочереди сортировал слева направо значения в зеленой зоне и подтягивал значения рыжей. Пример конечного результата также прилагается.

Заранее спасибо огроменное
 
Записать действия авторекордером + не большая корректировка на проверку цвета фона) Ну или написать все с нуля. В сети много информации на тему VBA.
 
Kosme, попробуйте макрос, полученный в основном правкой записи макрорекордера. Перед запуском выделите любую ячейку таблицы, диапазон определяется как текущая область выделенной ячейки (Ctrl+*). Столбцы, по которым идет сортировка, определяются по заголовку, начинающемуся с числа.
Код
Sub Макрос1()
Dim r As Range, i&
  Set r = Selection.CurrentRegion
  With ActiveSheet.Sort.SortFields
    .Clear
    For i = r.Columns.Count To 2 Step -1
      If Val(r(1, i)) Then
        .Add Key:=r.Columns(i), SortOn:=xlSortOnValues, Order:=xlDescending, _
          DataOption:=xlSortNormal
      Else: Exit For
      End If
    Next
  End With
  With ActiveSheet.Sort
    .SetRange r
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
End Sub
 
ух спасибо, вроде всё работает если выделять данные вместе с шапкой (т.е. сортировка тогда спускается на уровень ниже и сортирует), есть небольшая загвоздка т.к. если речь идет про "кусок" таблицы который нужно так отсортировать - то сортируются данные и сверху и снизу, а не в выбранном диапазоне и каждый раз приходится вырезать и сортировать макросом отдельно
Изменено: Kosme - 16.03.2018 16:22:01
 
Kosme, а поставть пару экспериментов с уже написанным для Вас кодом? Например убрать ".CurrentRegion" и выделить нужный для сортировки кусок.
Слева направо и по возрастанию в выделенном диапазоне (изменный код от Казанского):
Код
Sub Macro1()
Dim r As Range, i&
Application.ScreenUpdating = False
Set r = Selection
With ActiveSheet.Sort.SortFields
    .Clear
    For i = 1 To r.Columns.Count
      .Add Key:=r.Columns(i), SortOn:=xlSortOnValues, Order:=xlAscending, _
          DataOption:=xlSortNormal
    Next
    With ActiveSheet.Sort
       .SetRange r
       .Header = xlNo
       .Apply
     End With
End With
Application.ScreenUpdating = True
End Sub

Код-дальтоник, цветов не различает.

Изменено: Anchoret - 16.03.2018 18:32:06
Страницы: 1
Наверх