排序行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的開始和結束的位置記錄在整數變量中，然後在符合所有條件後將其更改爲範圍對象。您可以將此範圍對象提供給您的排序功能。

只是要咀嚼。