对行组进行排序 Excel VBA 宏

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

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

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

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

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

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

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

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

描述的代码如下：

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

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您可以将 rand 的开头和结尾的位置记录在整数变量中，然后在满足所有条件后将其更改为范围对象，而不是执行类似的操作。您可以将此范围对象输入到排序函数中。

只是一些可以咀嚼的东西。