Сортировка групп строк Excel VBA Macro

Question

У меня возникают проблемы с выяснением того, как создать алгоритм сортировки в VBA, который сортирует и заменяет группы строк (по несколько строк за раз).Я написал успешный алгоритм сортировки, используя массив ниже:

Function SortArray(ByRef arrToSort As Variant)
Dim aLoop As Long, aLoop2 As Long
Dim str1 As String
Dim str2 As String
For aLoop = 1 To UBound(arrToSort)
   For aLoop2 = aLoop To UBound(arrToSort)
        If UCase(arrToSort(aLoop2)) < UCase(arrToSort(aLoop)) Then
            str1 = arrToSort(aLoop)
            str2 = arrToSort(aLoop2)
            arrToSort(aLoop) = str2
            arrToSort(aLoop2) = str1
        End If
    Next aLoop2
Next aLoop
SortArray = arrToSort

(где каждый элемент является элементом массива), но теперь я хочу отсортировать, меняя строки или группы строк.Ниже я объясню, что я имею в виду.

У меня есть рабочий лист с заголовками вверху и строками данных внизу:

Я хочу написатькоманда, которая работает как алгоритм выше.ОДНАКО, вместо замены элементов массива я хочу поменять местами целые группы строк .Заголовок3 ((может быть любой строкой) определяет группировку. Все группы на рабочем листе сортируются по отдельности и группируются.

Для того, чтобы выполнить свопирование сгруппированных строк, я написал следующую подпрограмму RowSwapper (), которая принимает двастроки, содержащие строки для обмена (например, в форме rws1 = "3: 5").

Public Sub RowSwapper(ByVal rws1 As String, ByVal rws2 As String)
'ACCOMODATE VARIABLE ROW LENGTHS!!!!
    ActiveSheet.Rows(rws1).Cut
    ActiveSheet.Rows(rws2).Insert Shift:=xlDown
    ActiveSheet.Rows(rws2).Cut
    ActiveSheet.Rows(rws1).Insert Shift:=xlDown
    MsgBox "RowSwapper: row" & rws1 & "swapped with row " & rws2
End Sub

Любые идеи? Моя стратегия, включая код, приведена ниже:

МОЯ СТРАТЕГИЯ: У меня есть массивы prLst и srtdPrLst. PrLst - это массив приоритетов сортировки. Позиция приоритета в prLst - это столбец (заголовок), к которому он относится. SrtdPrLst - это массив, содержащий эти приоритеты.отсортировано в порядке возрастания чисел (например, 1,2,3 ....)

Я перебираю srtdPrLst при вызове функции FindPosition, чтобы найти позицию каждого приоритета. Я переворачиваю в обратном порядке, чтобы отсортировать в правильном порядке.

Для сортировки групп строк я затем использую ту же технику, что и приведенный выше код SortArray, однако мне нужно собрать строки, в которых существует группа. Для этого, У меня есть два цикла Do While, вложенных в циклы for, по одному для каждой группы (поскольку я сравниваю две группы в).Эти строки хранятся в переменных grpCnt1 (для первой сравниваемой группы) и grpCnt1 (для второй сравниваемой группы).

Поскольку отдельные группы уже отсортированы, мне нужно сравнить только первый ряд каждой группы.Я сравниваю строки grp1Val с grp2Val с помощью простого оператора If.Если строки не в алфавитном порядке, я вызываю rowSwapper (указан выше), чтобы поменять их местами.

Описанный ниже код:

lstRowVal = Int (ActiveSheet.Range ("AB" &totCount) .Value) 'Индексом в массиве prLst является столбец, в котором назначен приоритет' следовательно, pos = номер столбца 'Сортировка в обратном порядке для получения приоритетов в порядке приоритета' MsgBox "marker =" & marker

For prior2 = Int(UBound(srtdPrLst)) To 1 Step -1
    MsgBox "prior2 = " & prior2
    If Int(srtdPrLst(prior2)) > 0 Then
        pos = FindPosition(Int(srtdPrLst(prior2)), prLst)

        'Algorithm to sort groups
        For lLoop = 2 To lstRowVal '2 b/c Starts at row below headers


            'Find first group to compare
            grp1Val = ActiveSheet.Range(Mid(alphabet, pos, 1) & lLoop).Value
            hdToGrp1Val = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) & lLoop).Value

            Do
                'nextGrp1Val = ActiveSheet.Range(Mid(alphabet, pos, 1) & (lLoop + grpCnt1)).Value
                nxtHdToGrp1 = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) & (lLoop + grpCnt1)).Value
                grpCnt1 = grpCnt1 + 1
            Loop While nxtHdToGrp1 = hdToGrp1Val


           For lLoop2 = lLoop To lstRowVal 

                'Find second group to compare
                grp2Val = ActiveSheet.Range(Mid(alphabet, pos, 1) & lLoop2).Value
                hdToGrp2Val = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) & lLoop2).Value

                Do
                    nxtHdToGrp2 = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) & (lLoop2 + grpCnt2)).Value
                    grpCnt2 = grpCnt2 + 1
                Loop While nxtHdToGrp2 = hdToGrp2Val

                If UCase(grp2Val) < UCase(grp1Val) Then
                    RowSwapper lLoop & ":" & (lLoop + grpCnt1), lLoop2 & ":" & (lLoop2 + grpCnt2) 
                End If

                grp2Val = ""
                lLoop2 = lLoop2 + grpCnt2
                grpCnt2 = 0

            Next lLoop2


            grp1Val = ""
            lLoop = lLoop + grpCnt1
            grpCnt1 = 0

        Next lLoop
    End If
Next prior2

Answer 1

Я согласен, что вопрос все еще немного неясен. Вы пытались выполнить сортировку из меню «Данные»> «Сортировать ...». Вы можете сортировать по нескольким ключам и использовать пользовательские списки.

Кроме того, так как вы сказали, что хотите несколько указателей на VBA ... :) Я не думаю, что такие вещи, как

Dim letString, idLabel, curCell As String

делает то, что вы ожидаете. То, что на самом деле здесь происходит, это

Dim letString as Variant, idLabel as Variant, curCell As String

потому что вы не указываете после каждой переменной. Я предполагаю, что вы на самом деле хотите:

Dim letString as String, idLabel as String, curCell As String

Во-вторых, если вы обеспокоены эффективностью, как в своем последнем комментарии, тогда я бы не стал использовать метод .select для манипулирования диапазонами. Вы можете сделать все в Excel без этого. Это просто лишнее бремя. Таким образом, вместо того, чтобы делать что-то вроде Selction.Resize(1).Select, вы можете записать местоположение начала и конца вашего ранда в целочисленную переменную, а затем изменить его на объект диапазона, как только все ваши критерии будут выполнены. Вы можете передать этот объект диапазона в вашу функцию сортировки.

Просто что-то пережевывать.