Макрос для сортировки данных из нескольких столбцов до следующей пустой строки, затем повторите

У меня есть лист с несколькими таблицами на одном листе «Лист1», разделенный пустой строкой.

Я хочу, чтобы VBA сортировал один за другим.

Соображения

  • Каждая таблица имеет разное количество строк
  • В дальнейшем количество столбцов также изменится

Что всегда будет одним и тем же:

  • Пустая строка между таблицами в столбце B, которая должна быть отправной точкой для Excel, чтобы распознать наличие новой таблицы.
  • Каждая таблица всегда будет отсортирована по столбцу C

Чтобы дать вам лучшую картину, я просматриваю перекрестные таблицы данных о потребителях, где:

КОЛОНКА A ТИП ВОПРОСА

КОЛОНКА B – ВАРИАНТЫ ОТВЕТОВ

СТОЛБЦ C. Заголовок ВСЕГО и содержит % для каждого варианта ответа.

Остальные столбцы следуют за %, как C, но с другими заголовками, такими как мужчина, женщина, пользователь, не пользователь, возраст 18–25 лет, возраст 26–34 .... и т. д.

Я хочу создать зацикленный макрос, который будет сортировать каждую таблицу (и все столбцы в таблице) по столбцу C в порядке возрастания, определяя, что он должен искать следующее пустое пространство, а таблица будет под ним.

Я пробовал смотреть Looping, Sorting и находить следующую пустую ячейку. Но я почему-то не могу собрать воедино.

Любая помощь будет оценена!

ИСХОДНЫЙ ФАЙЛ

ПОСЛЕ ЖЕЛАЕМОГО ВЫВОДА МАКРО

Предыдущий код попробовал:

Dim oneArea as Range

For Each oneArea in Range("C:C").SpecialCells(xlCellTypeConstants).Area
    oneArea.EntireRow.Sort key1:=oneArea.Cells(1,1), order1:=xlAscending
Next oneArea

Для ссылки: это самый близкий пример и макрос, который я нашел для того, к чему я стремлюсь, но он не применим к моему сценарию / не может заставить его работать:

Макрос для сортировки данных до появления пустых строк, затем повторите< /а>


loops excel vba columnsorting
person Tamichan    schedule 23.01.2017    source источник
comment
Можете ли вы опубликовать некоторые образцы данных? (Скопируйте/вставьте в виде таблицы) или, в худшем случае, снимок экрана с данными и ожидаемый результат? Кроме того, что вы пробовали до сих пор? Пожалуйста, опубликуйте любой код, который у вас есть.   -  person BruceWayne    schedule 23.01.2017
comment
Конечно, я не смог прикрепить excel, добавил несколько скриншотов и кодов.   -  person Tamichan    schedule 23.01.2017
comment
Для поиска следующей таблицы вы можете использовать Selection.End(xlDown).Select, и когда вы найдете первую ячейку новой таблицы и выберите ее, вы можете использовать это для выбора области, которую хотите отсортировать: Selection.resize(Selection.Rows.Count,Selection.Columns.Count - 1).Offset(0,1).Select   -  person Egan Wolf    schedule 23.01.2017

Ответы (1)


arrow_upward
0
arrow_downward

Следующий код перебирает каждую строку на вашем листе, проверяет начало и конец каждой таблицы и сортирует их. Наслаждаться.

Sub Mak1()
Dim LastRow As Long, LastCol As Long
Dim TabBeg As Long, TabEnd As Long

    With Sheets("Sheet1")
        LastRow = .Cells(.Rows.Count, 2).End(xlUp).row
        LastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        TabBeg = 4
        TabEnd = 4
        For i = 4 To LastRow + 1
            If .Cells(i, 2).Value = "" Then
                With .Sort
                    .SortFields.Clear
                    .SortFields.Add Key:=Range(Cells(TabBeg, 3), Cells(TabEnd, 3)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                    .SetRange Range(Cells(TabBeg, 2), Cells(TabEnd, LastCol))
                    .Header = xlNo
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
                TabBeg = i + 1
                TabEnd = i
            Else
                TabEnd = TabEnd + 1
            End If
         Next i
    End With

End Sub
person Limak    schedule 23.01.2017
comment
РАБОТАЕТ ОТЛИЧНО! Большое спасибо! :) - person Tamichan; 24.01.2017
comment
Вы можете отметить эту зеленую галочку рядом с моим ответом, чтобы отметить его как решение;) - person Limak; 24.01.2017