[VBA]Excelのシートを並べ替え

[はじめに]
Excelでシートを昇順に並べ替える機会があったので、
備忘録としてサンプルソースを掲載します。
サンプルは昇順ソートですが、引数を変更すると降順にも対応できるようにしています。

[ソース]

コードのコピー

Option Explicit '''<summary> '''ソートの向き '''</summary> '''<remarks></remarks> Public Enum SortType     '昇順     Asc = 1     '降順     Desc = -1 End Enum '''<summary> '''シートをソートする。 '''</summary> '''<remarks></remarks> Public Sub SortSheet()     Dim sht As Worksheet     Dim i As Integer     Dim shtName As Variant     Dim shtNameList() As String          'シート名を配列で取得する。     For Each sht In ThisWorkbook.Worksheets         ReDim Preserve shtNameList(i)         shtNameList(i) = sht.Name         i = i + 1     Next     '配列でソートする。     SortByQuick shtNameList, SortType.Asc, 0, UBound(shtNameList)     '配列の順番でシートをソートする。     Dim strWork As String     strWork = shtNameList(UBound(shtNameList))          For i = 0 To UBound(shtNameList)         ThisWorkbook.Sheets(shtNameList(i)).Move after:=ThisWorkbook.Sheets(strWork)         strWork = shtNameList(i)     Next End Sub '''<summary> '''Stringの配列を名称の昇順にソートする。 '''</summary> '''<param name="argAry">ソート対象の配列</param> '''<param name="sort">ソートの向き　※省略時：Asc（昇順）</param> '''<param name="lngMin">対象範囲の最小インデックス ※省略時：argAryの最小インデックス</param> '''<param name="lngMax">対象範囲の最大インデックス ※省略時：argAryの最大インデックス</param> '''<remarks></remarks> Private Sub SortByQuick( _         ByRef argAry() As String, _         Optional ByVal sort As SortType = SortType.Asc, _         Optional ByVal lngMin As Long = -1, _         Optional ByVal lngMax As Long = -1)          Dim i As Long     Dim j As Long     Dim vBase As String     Dim vSwap As String          If lngMin < 0 Then         lngMin = LBound(argAry)     End If          If lngMax < 0 Then         lngMax = UBound(argAry)     End If          vBase = argAry((lngMin + lngMax) \ 2)          i = lngMin     j = lngMax          Do         Do While StrComp(argAry(i), vBase) * sort < 0             i = i + 1         Loop                  Do While StrComp(argAry(j), vBase) * sort > 0             j = j - 1         Loop                  If i >= j Then             Exit Do         End If                  vSwap = argAry(i)         argAry(i) = argAry(j)         argAry(j) = vSwap                  i = i + 1         j = j - 1     Loop          If lngMin < i - 1 Then         SortByQuick argAry, sort, lngMin, i - 1     End If          If lngMax > j + 1 Then         SortByQuick argAry, sort, j + 1, lngMax     End If End Sub

[VBA]シートの並べ替え

タグ：シートのソート シートの並べ替え VBA Excel