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

任何想法我的策略，包括代码，下面列出：？

MY策略： 我有数组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）。价值） “阵列中的索引prLst是在其中优先级被分配给 列“因此，POS =列数 ”向后，以获得在appriopriate为了优先排序 “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 

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

只是要咀嚼。