对行组进行排序 Excel VBA 宏

Sorting Groups of Rows Excel VBA Macro

提问by H3lue

I am having trouble figuring out how to create a sorting algorithm in VBA that sorts and swaps groups of rows (several rows at a time). I wrote a successful sorting algorithm using an array below:

我无法弄清楚如何在 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

(where each element is an element of an array) but now I want to sort by swapping rows or groups of rows. I'll explain what I mean below.

（其中每个元素都是数组的一个元素）但现在我想通过交换行或行组进行排序。我将在下面解释我的意思。

I have a worksheet with headers at the top and rows of data underneath:

我有一个工作表，顶部有标题，下面有数据行：

I want to write a command that works like the algorithm above. HOWEVER, instead of swapping elements of an array I want to swap entire groups of rows. Header3 ((Can be any string) determines the grouping. All groups on the worksheet are sorted individually and a grouping.

我想编写一个类似于上述算法的命令。但是，我想交换整组行，而不是交换数组的元素。Header3（（可以是任何字符串）决定分组。工作表上的所有组都是单独排序的，一个分组。

In order to do swap grouped rows, I wrote the following sub RowSwapper() that takes in two strings containing the rows to swap. (e.g. in the form rws1 = "3:5").

为了交换分组的行，我编写了以下子 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

Any ideas?My strategy, including code, is listed below:

有任何想法吗？我的策略，包括代码，如下所列：

MY STRATEGY: I have the arrays prLst and srtdPrLst. prLst is an array of sorting priorities. The position of the priority in prLst is the column (header) to which it refers. srtdPrLst, is an array containing those priorities sorted in numerically ascending order (e.g. 1,2,3....)

我的策略：我有数组 prLst 和 srtdPrLst。prLst 是排序优先级的数组。prLst 中优先级的位置是它所引用的列（标题）。srtdPrLst，是一个包含按数字升序排列的优先级的数组（例如 1,2,3....）

I loop through srtdPrLst while calling function FindPosition to find position of each priority. I loop backwards in order to sort in the proper order.

我在调用函数 FindPosition 时循环遍历 srtdPrLst 以查找每个优先级的位置。我向后循环以按正确的顺序排序。

To sort groups of rows, I then use the same technique as the SortArray code above. However, I need to gather the rows in which a group exists. To do this, I have two Do While loops nested under the for loops, one for each group (since I am comparing two groups at). These rows are stored in variables grpCnt1 (for first compared group) and grpCnt1 (for second compared group).

为了对多组行进行排序，我使用与上面的 SortArray 代码相同的技术。但是，我需要收集存在组的行。为此，我在 for 循环下嵌套了两个 Do While 循环，每组一个（因为我在比较两个组）。这些行存储在变量 grpCnt1（对于第一个比较组）和 grpCnt1（对于第二个比较组）中。

Since individual groups are already sorted, I only need to compare the first row of each group. I compare the strings grp1Val with grp2Val with a simple If statement. If the strings are not in alphabetical order, I call rowSwapper (listed above) to swap them.

由于各个组已经排序，我只需要比较每个组的第一行。我用一个简单的 If 语句比较了字符串 grp1Val 和 grp2Val。如果字符串不是按字母顺序排列的，我会调用 rowSwapper（上面列出的）来交换它们。

The code described is below:

描述的代码如下：

lstRowVal = Int(ActiveSheet.Range("AB" & totCount).Value) 'The index in the array prLst is the column at which a priority is assigned to 'therefore, pos = column number 'Sorts backwards in order to get priorities in appriopriate order 'MsgBox "marker = " & marker

lstRowVal = Int(ActiveSheet.Range("AB" & totCount).Value) '数组 prLst 中的索引是分配优先级的列 '因此，pos = 列号 '向后排序以获得优先级适当的顺序 'MsgBox "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

回答by Brad

I agree that the question is still a little unclear. Have you tried doing a sort from the Data>Sort... You can sort using multiple keys and use custom lists.

我同意这个问题仍然有点不清楚。您是否尝试过从 Data>Sort... 进行排序？您可以使用多个键进行排序并使用自定义列表。

Additionally since you said you wanted some pointers on the VBA...:) I don't think stuff like

此外，因为你说你想要一些关于 VBA 的指针......:) 我不认为像

Dim letString, idLabel, curCell As String

is doing what you are expecting. What is actually happening here is

正在做你期待的事情。这里实际发生的是

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

because you don't specify after each variable. I assume what you want here is actually:

因为您没有在每个变量之后指定。我假设你在这里想要的实际上是：

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

Second, if you are concerned about efficiency like in your last comment then I would avoid using the .select method of manipulating ranges. You can do everything in excel without it. It is just an extra burden. So instead of doing something like Selction.Resize(1).Selectyou could log the locations of the beginning and end of your rand in an integer variable then change it into a range object once all your criteria are met. You can feed this range object into your sorting function.

其次，如果您像上一条评论一样担心效率，那么我会避免使用 .select 操作范围的方法。没有它，你可以在 excel 中做任何事情。这只是额外的负担。因此，Selction.Resize(1).Select与其做类似的事情，不如将 rand 的开头和结尾的位置记录在一个整数变量中，然后在满足所有条件后将其更改为范围对象。您可以将此范围对象提供给您的排序功能。

Just something to chew on.

只是可以咀嚼的东西。