对行组进行排序Excel VBA宏

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

最佳答案

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

另外，由于您说过您想要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开头和结尾的位置，然后在满足所有条件后将其更改为range对象。您可以将此范围对象输入到排序功能中。

只是要咀嚼的东西。