排序行组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 循环，每个组一个（因为我在比较两个组）。这些行存储在变量 grpCnt1（用于第一个比较组）和 grpCnt1（用于第二个比较组）中。

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

描述的代码如下：

lstRowVal = Int(ActiveSheet.Range("AB" & totCount).Value) '数组prLst中的索引是分配优先级的列 '因此，pos = 列号 '向后排序以便按适当的顺序获得优先级 'MsgBox "标记 = " & 标记

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 的开始和结束位置记录在一个整数变量中，然后在满足所有条件后将其更改为范围对象。您可以将此范围对象输入到您的排序函数中。

只是一些值得咀嚼的东西。