Geminiと100本ノック 15本目：シートの並べ替え

公開日：2025-05-06　最終更新日：2025-05-08

Geminiと100本ノック 15本目：シートの並べ替え

AIのGeminiがVBA100本ノックに挑戦！

Googleが開発した生成AIモデルのGeminiにVBA100本ノックをやってもらいました。
AIがVBAをどこまで扱えるかの実証実験の15本目です。

2025年3月からGemsが無料で使えるようになりました。
そこで、独自に作成したGem（名前は「AI神髄VBA」改良を続けている）を使った回答も掲載しています。

VBA100本ノックの出題と解答

VBA100本ノック 15本目：シートの並べ替え

・出題・頂いた回答・解説・補足・サイト内関連ページ

Geminiへの出題とGeminiの回答

Geminiの回答 Geminiへの出題

VBA問題
「2020年04月」から「2021年03月」のシートがあります。
しかし、シートの順番が狂ってしまっています。
「2020年04月」から昇順に並べ替えてください。
・上記以外のシートは存在しません。
・シート名は「yyyy年mm月」これで統一されています。

はい、承知いたしました。「2020年04月」から「2021年03月」までのシートを日付順に並べ替えるVBAコードを以下に示します。

VBA


        
          
            Sub SortSheetsByDate()


　　Dim ws As Worksheet

　　Dim i As Integer

　　Dim j As Integer

　　Dim sheetCount As Integer

　　Dim sheetArray() As Variant

　　Dim temp As Variant

　　Dim sheetDate As Date


　　'シート数を取得

　　sheetCount = ThisWorkbook.Sheets.Count


　　'シート名と日付を格納する配列を定義

　　ReDim sheetArray(1 To sheetCount, 1 To 2)


　　'配列にシート名と対応する日付を格納

　　For i = 1 To sheetCount

　　　　Set ws = ThisWorkbook.Sheets(i)

　　　　'シート名から日付情報を作成

　　　　'エラー処理を追加：シート名が期待する形式でない場合はスキップ

　　　　On Error Resume Next

　　　　sheetDate = DateValue(Replace(ws.Name, "年", "/") & "/1") '月の初日の日付として扱う

　　　　On Error GoTo 0


　　　　If sheetDate <> 0 Then '正常に日付に変換できた場合

　　　　　　sheetArray(i, 1) = ws.Name

　　　　　　sheetArray(i, 2) = sheetDate

　　　　Else

　　　　　　'日付に変換できなかったシート（今回の問題では発生しない想定だが念のため）

　　　　　　'ここでは何もしないか、エラーメッセージを表示することも可能

　　　　　　'Debug.Print "Warning: Sheet '" & ws.Name & "' does not match the expected format."

　　　　End If

　　Next i


　　'日付を基に配列を並べ替え（バブルソート）

　　For i = 1 To sheetCount - 1

　　　　For j = i + 1 To sheetCount

　　　　　　If sheetArray(i, 2) > sheetArray(j, 2) Then

　　　　　　　　'要素を交換

　　　　　　　　temp = sheetArray(i, 1)

　　　　　　　　sheetArray(i, 1) = sheetArray(j, 1)

　　　　　　　　sheetArray(j, 1) = temp


　　　　　　　　temp = sheetArray(i, 2)

　　　　　　　　sheetArray(i, 2) = sheetArray(j, 2)

　　　　　　　　sheetArray(j, 2) = temp

　　　　　　End If

　　　　Next j

　　Next i


　　'並べ替えた順にシートを移動

　　For i = 1 To sheetCount

　　　　ThisWorkbook.Sheets(sheetArray(i, 1)).Move After:=ThisWorkbook.Sheets(i - 1)

　　Next i


　　MsgBox "シートの並べ替えが完了しました。", vbInformation


            End Sub

コードの説明:

SortSheetsByDate という名前のマクロを開始します。
必要な変数を宣言します。sheetArray はシート名とそれに対応する日付を格納するための配列です。
ThisWorkbook.Sheets.Count でブック内のシート数を取得します。
sheetArray のサイズを取得したシート数に合わせて動的に変更します。
最初の For ループで、ブック内の各シートを順番に処理します。
シート名 (ws.Name) を取得し、「年」を「/」に置換して、月の初日の日付として認識できる文字列に変換します（例: "2020年04月" -> "2020/04/1"）。
DateValue 関数を使って、この文字列を日付型のデータ (sheetDate) に変換します。エラー処理 (On Error Resume Next と On Error GoTo 0) を入れて、万が一シート名が想定される形式でない場合でもマクロが中断しないようにしています。
正常に日付に変換できた場合、sheetArray にシート名と日付を格納します。
ネストされた For ループ（バブルソート）を使用して、sheetArray を日付 (sheetArray(i, 2)) を基準に昇順に並べ替えます。
最後の For ループで、並べ替えられた sheetArray の順序に従って、実際にシートを移動します。Sheets(sheetArray(i, 1)).Move After:=Sheets(i - 1) は、指定されたシート (sheetArray(i, 1) に格納されているシート名) を、その一つ前のシート (Sheets(i - 1)) の後ろに移動させる命令です。これにより、シートが順番に並べ替えられます。
最後に、並べ替えが完了したことを示すメッセージボックスを表示します。

使い方:

Alt + F11 キーを押してVBAエディターを開きます。
メニューバーの「挿入」から「標準モジュール」を選択します。
表示された白い画面に上記のコードを貼り付けます。
VBAエディターを閉じます (Alt + F11 を再度押すか、右上の閉じるボタン)。
Excelに戻り、Alt + F8 キーを押してマクロダイアログを開きます。
「SortSheetsByDate」を選択し、「実行」ボタンをクリックします。
これにより、シートが「2020年04月」から「2021年03月」まで日付順に並べ替えられます。

このVBAは実行するとエラーになります。
とにかく、エラーをGeminiに伝えてみましょう。
なるべく詳細に伝えるようにします。

Geminiの回答 Geminiへの出題

エラーになりました。

エラーが発生したとのこと、申し訳ありません。

アップロードしていただいた画像から、「実行時エラー '9': インデックスが有効範囲にありません。」というエラーが表示され、原因となっているコードが ThisWorkbook.Sheets(sheetArray(i, 1)).Move After:=ThisWorkbook.Sheets(i - 1) の行であることが確認できました。

このエラーは、シートを移動する際に指定しているインデックス（位置）が正しくない場合に発生します。特に i - 1 の部分で、 i が 1 のときに 0 になり、シートのインデックスは 1 から始まるため Sheets(0) は存在しないためです。

最初のシート（i = 1 の場合）を移動する際は、既存の最初のシートの前に移動させる必要があります。

以下の修正コードをお試しください。シートを移動する部分で、i = 1 の場合とそれ以外で処理を分けました。

VBA


        
          
            Sub SortSheetsByDate_Revised()


　　Dim ws As Worksheet

　　Dim i As Integer

　　Dim j As Integer

　　Dim sheetCount As Integer

　　Dim sheetArray() As Variant

　　Dim temp As Variant

　　Dim sheetDate As Date


　　'シート数を取得

　　sheetCount = ThisWorkbook.Sheets.Count


　　'シート名と日付を格納する配列を定義

　　'シート数が0の場合は処理しない

　　If sheetCount = 0 Then

　　　　MsgBox "ブックにシートがありません。", vbInformation

　　　　Exit Sub

　　End If


　　ReDim sheetArray(1 To sheetCount, 1 To 2)


　　'配列にシート名と対応する日付を格納

　　For i = 1 To sheetCount

　　　　Set ws = ThisWorkbook.Sheets(i)

　　　　'シート名から日付情報を作成

　　　　'エラー処理を追加：シート名が期待する形式でない場合はスキップ

　　　　On Error Resume Next

　　　　' シート名から日付を正確に解析するために、年、月、日を分解してDateSerialを使用

　　　　Dim yearStr As String

　　　　Dim monthStr As String

　　　　Dim firstDigitPos As Integer

　　　　Dim yearEndPos As Integer

　　　　Dim monthEndPos As Integer


　　　　' 年の開始位置を探す (最初の数字)

　　　　For firstDigitPos = 1 To Len(ws.Name)

　　　　　　If IsNumeric(Mid(ws.Name, firstDigitPos, 1)) Then Exit For

　　　　Next firstDigitPos


　　　　' 年の終了位置を探す ('年'の前)

　　　　yearEndPos = InStr(ws.Name, "年")


　　　　' 月の終了位置を探す ('月'の前)

　　　　monthEndPos = InStr(ws.Name, "月")


　　　　If firstDigitPos > 0 And yearEndPos > firstDigitPos And monthEndPos > yearEndPos Then

　　　　　　yearStr = Mid(ws.Name, firstDigitPos, yearEndPos - firstDigitPos)

　　　　　　monthStr = Mid(ws.Name, yearEndPos + 1, monthEndPos - yearEndPos - 1)


　　　　　　' 数字のみで構成されているか確認

　　　　　　If IsNumeric(yearStr) And IsNumeric(monthStr) Then

　　　　　　　　' DateSerial関数で日付を作成 (日を1日として扱う)

　　　　　　　　sheetDate = DateSerial(CInt(yearStr), CInt(monthStr), 1)

　　　　　　Else

　　　　　　　　sheetDate = 0 ' 不正な形式の場合は0をセット

　　　　　　End If

　　　　Else

　　　　　　sheetDate = 0 ' 不正な形式の場合は0をセット

　　　　End If


　　　　On Error GoTo 0 ' エラー処理を解除


　　　　If sheetDate <> 0 Then '正常に日付に変換できた場合

　　　　　　sheetArray(i, 1) = ws.Name

　　　　　　sheetArray(i, 2) = sheetDate

　　　　Else

　　　　　　'日付に変換できなかったシート（今回の問題では発生しない想定だが念のため）

　　　　　　' Debug.Print "Warning: Sheet '" & ws.Name & "' does not match the expected format and will not be sorted."

　　　　　　' 不正なシートは配列に含めない、またはソート対象外とする処理も検討できますが、

　　　　　　' 今回は問題の前提より全て「yyyy年mm月」形式と仮定し、このElseブロックは主にデバッグ用です。

　　　　　　' もし前提が崩れる可能性がある場合は、ここで配列への格納をスキップするなどの処理が必要です。

　　　　　　' 今回は前提に基づき、日付変換できたシートのみを対象に進めます。

　　　　　　' もし全て日付に変換できない場合は、次のソートや移動のループでエラーになる可能性があります。

　　　　End If

　　Next i


　　' 有効な日付を持つシートのみを対象に配列を再構築 (オプション、より堅牢にする場合)

　　' ここではシンプルに、元々の配列で日付が0でないものだけをソート対象とみなします。

　　' もし不正なシートが混じる場合は、別途処理が必要です。


　　'日付を基に配列を並べ替え（バブルソート）

　　' 日付が0（不正な形式）のシートはソート対象外とする

　　For i = 1 To sheetCount - 1

　　　　For j = i + 1 To sheetCount

　　　　　　If sheetArray(i, 2) <> 0 And sheetArray(j, 2) <> 0 Then ' 両方とも有効な日付の場合のみ比較

　　　　　　　　If sheetArray(i, 2) > sheetArray(j, 2) Then

　　　　　　　　　　'要素を交換

　　　　　　　　　　temp = sheetArray(i, 1)

　　　　　　　　　　sheetArray(i, 1) = sheetArray(j, 1)

　　　　　　　　　　sheetArray(j, 1) = temp


　　　　　　　　　　temp = sheetArray(i, 2)

　　　　　　　　　　sheetArray(i, 2) = sheetArray(j, 2)

　　　　　　　　　　sheetArray(j, 2) = temp

　　　　　　　　End If

　　　　　　End If

　　　　　　 ' 片方または両方の日付が0の場合は何もしない（ソートの対象外としてそのままの位置に置かれる）

　　　　Next j

　　Next i


　　'並べ替えた順にシートを移動

　　For i = 1 To sheetCount

　　　　' sheetArray(i, 2)が0の場合は不正なシートなので移動しない

　　　　If sheetArray(i, 2) <> 0 Then

　　　　　　If i = 1 Then

　　　　　　　　'最初のシートは一番前に移動

　　　　　　　　ThisWorkbook.Sheets(sheetArray(i, 1)).Move Before:=ThisWorkbook.Sheets(1)

　　　　　　Else

　　　　　　　　'2番目以降のシートは並べ替えられた順の前のシートの後に移動

　　　　　　　　' ここで i-1 の位置に正しいシートがあることを保証する必要があるが、

　　　　　　　　' シンプルなバブルソートでは不正なシートが混じるとこのロジックが崩れる可能性がある。

　　　　　　　　' 問題の前提「上記以外のシートは存在しません。」に基づけば、全て有効なシートなのでこのままで良い。

　　　　　　　　 ThisWorkbook.Sheets(sheetArray(i, 1)).Move After:=ThisWorkbook.Sheets(sheetArray(i - 1, 1)) ' 修正箇所: i-1 番目のシート名で指定

　　　　　　End If

　　　　End If

　　Next i


　　MsgBox "シートの並べ替えが完了しました。", vbInformation


End Sub

修正点:

シート移動のロジック:
- For i = 1 To sheetCount ループ内で、i が 1 の場合は ThisWorkbook.Sheets(sheetArray(i, 1)).Move Before:=ThisWorkbook.Sheets(1) として、ブックの最初のシートの前に移動するようにしました。
- i が 1 より大きい場合は、元のコード ThisWorkbook.Sheets(sheetArray(i, 1)).Move After:=ThisWorkbook.Sheets(i - 1) で問題ありません。これは、i - 1 番目の位置にはすでに並べ替え済みのシートが配置されているためです。
- After の指定を ThisWorkbook.Sheets(sheetArray(i - 1, 1)) に変更しました。これは、i-1 番目の位置に移動したシートは、配列の i-1 番目に格納されているシート名であるため、そのシート名を指定してその後に移動するようにするためです。
日付解析の強化: DateValue(Replace(ws.Name, "年", "/") & "/1") の代わりに、シート名から「年」と「月」の部分をより正確に抽出し、DateSerial 関数を使って日付を作成するようにしました。これにより、シート名の形式に多少のブレがあっても対応できる可能性が高まります（ただし、前提として「yyyy年mm月」形式であることは重要です）。
不正なシート名への対応（補足）: sheetDate = 0 のチェックを追加し、日付に変換できなかったシート（問題の前提では発生しない想定ですが）はソートや移動の対象外となるように調整しました。これにより、想定外のシート名があってもエラーになりにくくなります。

修正後のコードを再度お試しいただけますでしょうか。もし再びエラーが発生するようでしたら、表示されたエラーメッセージと、エラーが発生している行のコードを教えていただけると助かります。

すごいですね。
エラー原因を的確に判断し、しっかりと間違いを訂正してきました。
デバッグ能力はかなり高いと思います。

AI神髄VBAへの出題とAI神髄VBAの回答

AI神髄VBAとは、GeminiのGems機能を使って作ったVBAに特化したカスタムAIです。
前回の10本目で使用したGemを今回は少し改良しました。

AI神髄VBAの回答 AI神髄VBAへの出題

はい、承知いたしました。ご提示の要件に基づき、Excelシートを日付順に高速に並べ替えるVBAコードを作成します。DictionaryオブジェクトとQuickSortアルゴリズムを組み合わせて、効率的なソートを実現します。

以下にVBAコードと解説を記述します。

VBA


        
          
            ' シートを日付（yyyy年mm月）の昇順に並べ替える

' 対象シート: 2020年04月 から 2021年03月

' 問題の前提として、対象となる「yyyy年mm月」形式のシートのみが存在し、

' それ以外のシートや不正なシート名はないものとします。

Sub SortSheetsByDate()


　　' 画面更新を停止し、シート移動時の描画処理を省略することで処理を高速化します。

　　Application.ScreenUpdating = False


　　' Scripting.Dictionaryオブジェクトを作成します。

　　' このDictionaryには、シートの日付をキー（ソートの基準となる値）、シート名をアイテムとして格納します。

　　' これにより、日付とシート名を紐づけたまま、日付でソートするための準備ができます。

　　Dim dict As Object

　　Set dict = CreateObject("Scripting.Dictionary")


　　Dim ws As Worksheet

　　Dim sheetDate As Date

　　Dim sheetName As String


　　' ブック内のすべてのシートをループ処理します。

　　' For Each ループを使用することで、コレクション内の各要素を順番に処理できます。

　　For Each ws In ThisWorkbook.Sheets

　　　　sheetName = ws.Name


　　　　' シート名（"yyyy年mm月" 形式）から日付シリアル値を作成します。

　　　　' シート名の「年」と「月」の部分を抽出し、間に"/"を入れて日付文字列を作成し、

　　　　' DateValue関数で日付型（日付シリアル値）に変換します。

　　　　' 日を1日として扱うことで、月の比較が可能になります。

　　　　' 例: "2020年04月" -> "2020/04/01" -> 日付シリアル値

　　　　sheetDate = DateValue(Left(sheetName, 4) & "/" & Mid(sheetName, 6, 2) & "/1")


　　　　' 作成した日付シリアル値をキー、元のシート名をアイテムとしてDictionaryに追加します。

　　　　' 問題の前提として、同じ日付を持つシート名はないため、キーの重複は発生しません。

　　　　dict(sheetDate) = sheetName

　　Next ws


　　' Dictionaryのキー（日付シリアル値）のみを配列として取得します。

　　' この配列をソートすることで、シートを並べ替える正しい順序が得られます。

　　Dim dateKeys As Variant

　　' dict.Keys メソッドはDictionaryのすべてのキーを含む配列を返します。

　　dateKeys = dict.Keys


　　' 取得した日付キー配列を昇順にソートします。

　　' 配列に要素が1つ以上存在する場合のみソートを実行します。

　　' IsArrayで変数dateKeysが配列であるかを確認し、UBound >= LBound で配列の要素数が1以上であるかを確認します。

　　If IsArray(dateKeys) Then

　　　　 If UBound(dateKeys) >= LBound(dateKeys) Then

　　　　　　' QuickSortヘルパープロシージャを呼び出し、日付キー配列を昇順にソートします。

　　　　　　' Call ステートメントはプロシージャ呼び出しを明示しますが、省略も可能です。

　　　　　　Call QuickSort(dateKeys, LBound(dateKeys), UBound(dateKeys))

　　　　End If

　　End If


　　Dim i As Long

　　Dim sortedSheetName As String


　　' ソートされた日付キー配列を「逆順」にループし、対応するシートを移動します。

　　' 日付が新しいシートから順に処理し、常にブックの一番左（Sheets(1)）に移動させることで、

　　' 最終的に一番左から日付の古い順（昇順）にシートが並びます。

　　' この方法は、シートの移動先インデックスを動的に計算するよりもシンプルで確実です。

　　' 例: ソート順が A, B, C の場合 (Aが一番古く、Cが一番新しい日付)

　　' 1. ソートされたキー配列の最後（一番新しい日付）に対応するシート C を Sheets(1) に移動します。 -> (現在のシート順に関わらず) C, ...

　　' 2. 次に古い日付に対応するシート B を Sheets(1) に移動します。(C の左に来る) -> B, C, ...

　　' 3. 次に古い日付に対応するシート A を Sheets(1) に移動します。(B の左に来る) -> A, B, C, ...

　　If IsArray(dateKeys) Then

　　　　' 配列の要素を逆順にループします (配列の最後 UBound から最初 LBound まで Step -1)。

　　　　For i = UBound(dateKeys) To LBound(dateKeys) Step -1

　　　　　　' ソートされた日付キー（dateKeys(i)）を使って、Dictionaryから対応するシート名を取得します。

　　　　　　' dict(dateKeys(i)) は、指定されたキー（日付シリアル値）に対応するアイテム（シート名）を返します。

　　　　　　sortedSheetName = dict(dateKeys(i))


　　　　　　' 取得したシート（sortedSheetName）をブックの一番左（インデックス1）に移動します。

　　　　　　' Sheets(1) は常にブックの一番左のシートオブジェクトを指します。

　　　　　　' Moveメソッドの Before:=Sheets(1) は、指定したシートを Sheets(1) の「前」に移動させることを意味します。

　　　　　　Sheets(sortedSheetName).Move Before:=Sheets(1)

　　　　Next i

　　End If


　　' 使用したDictionaryオブジェクトの参照を解放します。

　　' 不要になったオブジェクトを解放することで、メモリの使用量を最適化します。

　　Set dict = Nothing


　　' 画面更新を再開します。

　　Application.ScreenUpdating = True


End Sub


'----------------------------------------------------------------------------

' ヘルパープロシージャ：配列を昇順にソートする (QuickSortアルゴリズム)

' このプロシージャは、再帰的に自身を呼び出して配列を分割・ソートします。

' 高速なソートアルゴリズムの一つとして広く利用されています。

'----------------------------------------------------------------------------

Private Sub QuickSort(arr As Variant, ByVal lowerBound As Long, ByVal upperBound As Long)

　　' arr: ソート対象の配列 (Variant型)。要素は比較可能なデータ型である必要があります。

　　' lowerBound: ソート範囲の開始インデックス (Long型)。配列の最小インデックス（LBound）から指定します。

　　' upperBound: ソート範囲の終了インデックス (Long型)。配列の最大インデックス（UBound）まで指定します。


　　Dim pivot As Variant ' ピボット（軸）の値。ソート範囲を分割する基準となります。

　　Dim i As Long　　　　' 左からの探索用インデックス。lowerBound から増加します。

　　Dim j As Long　　　　' 右からの探索用インデックス。upperBound から減少します。

　　Dim temp As Variant　' 要素交換用の一時変数。Variant型で、どのようなデータ型でも格納できます。


　　' ベースケース（再帰の停止条件）:

　　' ソート範囲の開始インデックスが終了インデックス以上であれば、

　　' その範囲は1要素以下であり、既にソート済みとみなせるため、処理を終了します。

　　If lowerBound >= upperBound Then

　　　　Exit Sub ' アーリーリターン

　　End If


　　' ピボットを選択します。

　　' 今回はソート範囲の中央の要素をピボットとして選択します。

　　i = lowerBound

　　j = upperBound

　　' インデックスの計算: (lowerBound + upperBound) を2で割った商（整数除算 \）をインデックスとします。

　　pivot = arr((lowerBound + upperBound) \ 2)


　　' パーティション（分割）処理を行うメインループ

　　' i が j を超えるまで繰り返します。このループにより、配列がピボットを境に2つの部分に分割されます。

　　Do While i <= j

　　　　' 左側からの探索: arr(i) がピボットより小さい間は i をインクリメントして右へ進みます。

　　　　' ピボット以上の値が見つかった時点で停止します。

　　　　While arr(i) < pivot

　　　　　　i = i + 1

　　　　Wend


　　　　' 右側からの探索: arr(j) がピボットより大きい間は j をデクリメントして左へ進みます。

　　　　' ピボット以下の値が見つかった時点で停止します。

　　　　While arr(j) > pivot

　　　　　　j = j - 1

　　　　Wend


　　　　' i と j が交差していない、または同じ位置にある場合:

　　　　' これは、左側でピボット以上の要素、右側でピボット以下の要素がそれぞれ見つかったことを意味します。

　　　　' これらの要素は現在のパーティションにおいて「正しい位置」にないため、交換する必要があります。

　　　　If i <= j Then

　　　　　　' arr(i) の要素と arr(j) の要素を交換します。

　　　　　　' 一時変数 temp を介して値を安全に交換します。

　　　　　　temp = arr(i)

　　　　　　arr(i) = arr(j)

　　　　　　arr(j) = temp


　　　　　　' 要素を交換したら、次の比較対象へ進むために i を1つ増やし、j を1つ減らします。

　　　　　　i = i + 1

　　　　　　j = j - 1

　　　　End If

　　Loop


　　' パーティション分割後、配列はピボットを境に左側（ピボット以下または同じ値）と右側（ピボット以上または同じ値）に大まかに分かれます。

　　' それぞれのサブ配列に対して、再帰的にQuickSortを呼び出し、ソートを繰り返すことで、配列全体がソートされます。


　　' 左側のサブ配列をソート

　　' lowerBound から 分割ループ終了時の j までの範囲が左側のサブ配列です。

　　If lowerBound < j Then

　　　　Call QuickSort(arr, lowerBound, j)

　　End If


　　' 右側のサブ配列をソート

　　' 分割ループ終了時の i から upperBound までの範囲が右側のサブ配列です。

　　If i < upperBound Then

　　　　Call QuickSort(arr, i, upperBound)

　　End If


End Sub

VBAコードの解説
このVBAコードは、以下の手順でExcelシートを「yyyy年mm月」の形式の日付の昇順に並べ替えます。

画面更新の停止: Application.ScreenUpdating = False を設定することで、シートの移動中に画面がちらつくのを防ぎ、処理速度を向上させます。
Dictionaryへの格納: Scripting.Dictionary オブジェクトを使用します。各シートを For Each ループで順に処理し、シート名から年と月を抽出して月初めの日付シリアル値を作成します。この日付シリアル値をDictionaryのキーとして、元のシート名をアイテムとして格納します。これにより、「どの日付がどのシート名に対応するか」という情報を効率的に保持できます。
日付キーの配列化とソート: Dictionaryのキー（日付シリアル値）を配列として取得します。取得した配列を、プライベートプロシージャ QuickSort を使って昇順にソートします。QuickSortは高速なソートアルゴリズムであり、Forループで自前で比較・交換するよりも効率的です。
シートの移動: ソートされた日付キー配列を逆順にループします。ループ中の日付キーを使ってDictionaryから対応するシート名を取得し、そのシートを Sheets(sortedSheetName).Move Before:=Sheets(1) によってブックの一番左（Sheets(1)の位置）に移動します。新しい日付のシートから順に一番左に移動していくことで、最終的に一番左から古い日付のシートが並び、日付の昇順に並べ替えが完了します。
Dictionaryの解放: 使用し終わったDictionaryオブジェクトの参照を Set dict = Nothing で解放します。
画面更新の再開: Application.ScreenUpdating = True を設定し、画面更新を元に戻します。
QuickSortプロシージャ: 配列とソート範囲を受け取り、QuickSortアルゴリズムで配列を昇順にソートするヘルパープロシージャです。再帰呼び出しを用いて配列を効率的に分割・ソートします。

このコードは、DictionaryとQuickSortというデータ構造およびアルゴリズムを活用することで、シート数が増えても比較的高いパフォーマンスで並べ替えを実行できます。また、シート名を日付として解釈し、その日付を基準にソートすることで、数値や文字列としての単純なソートでは実現できない正確な並べ替えを行っています。

ひえー、こんなVBAコードをあっさりAIに出されたら・・・
人が「VBA書けます。」なんて、なんの自慢にもならないってことかな・・・

同じテーマ「生成AI活用研究」の記事

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.繰り返し処理（For Next)｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
5.ひらがな⇔カタカナの変換｜エクセル基本操作
6.RangeとCellsの使い方｜VBA入門
7.メッセージボックス(MsgBox関数)｜VBA入門
8.セルのクリア（Clear,ClearContents）｜VBA入門
9.FILTER関数（範囲をフィルター処理）｜エクセル入門
10.条件分岐（Select Case）｜VBA入門

ホーム
その他
生成AI活用研究
Geminiと100本ノック 15本目：シートの並べ替え

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

生成AI活用研究
Geminiと100本ノック 15本目：シートの並べ替え