行グループの並べ替え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 

（各要素は、配列の要素である）が、今、私は、行の行またはグループを交換することによりソートしたい：私は、以下の配列を使用して成功したソートアルゴリズムを書きました。私は下の意味を説明します。

私はトップと下にデータの行のヘッダを持つワークシートを持っている：

私は上記のアルゴリズムのように動作し、コマンドを書きたいです。配列の要素を入れ替えるのではなく、私はの行全体を入れ替えたいと思っています。ワークシートのすべてのグループが個別にソートされ、グループ化されます。

グループ化された行をスワップするために、次のサブRowSwapper（）を記述しています。行は、スワップする（例えば= "3：5" フォームrws1で）。

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戦略： Iを配列prLstとsrtdPrLstを持ちます.prLstはソート優先順位の配列です。 prLstの優先順位は、それが参照する列（ヘッダー）です。 srtdPrLstは、優先順位が数値昇順にソートされた配列です（例えば、1,2,3 ....）。

私は関数FindPositionを呼び出して各優先順位の位置を見つけるときにsrtdPrLstをループします。正しい順序でソートするために、私は後方にループします。

行のグループを並べ替えるには、上記のSortArrayコードと同じ方法を使用します。しかし、グループが存在する行を集める必要があります。これを行うために、forループの下にネストされた2つのDo Whileループがあります（2つのグループを比較しているため）。これらの行は、変数grpCnt1（最初に比較されたグループの場合）およびgrpCnt1（2番目の比較されたグループの場合）に格納されます。

個々のグループはすでにソートされているので、各グループの最初の行を比較するだけで済みます。私は文字列grp1Valとgrp2Valを単純なIf文と比較します。文字列がアルファベット順でない場合、私はそれらをスワップするために上記のrowSwapperを呼び出します。

記載コードは以下である：配列prLstで

lstRowVal = INT（ActiveSheet.Range（ "AB" & totCount）.Valueの） 」指数は、優先順位が に割り当てされたカラムであります「そのため、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

appriopriate順に優先順位を取得するために、逆方向にソートします。あなたは、データ>並べ替えから並べ替えを試したことがありますか？複数のキーを使用して並べ替えることができ、カスタムリストを使用できます。

また、あなたは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メソッドを使用して避けるだろう。あなたはそれなしですべてを行うことができます。余計な負担に過ぎません。従って、Selction.Resize(1).Selectのようなことをするのではなく、あなたのrandの始めと終わりの位置を整数変数に記録してから、すべての基準が満たされたら範囲オブジェクトに変更することができます。この範囲オブジェクトをソート関数に送ることができます。

ちょうど噛みつくもの。