排序行组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

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

此外，既然你说你想要一些关于 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 的开始和结束位置记录在一个整数变量中，然后在满足所有条件后将其更改为范围对象。您可以将此范围对象提供给您的排序功能。

只是需要咀嚼的东西。