Geminiと100本ノック 12本目：セル結合の解除

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

Geminiと100本ノック 12本目：セル結合の解除

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

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

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

VBA100本ノックの出題と解答

VBA100本ノック 12本目：セル結合の解除

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

Geminiへの出題とGeminiの回答

Geminiの回答 Geminiへの出題

VBA問題
A1から始まる表範囲のC列に金額が入っています。
しかし、ところどころに結合されたセルがあります。
セル結合を解除し、入っている金額を整数で均等に割り振ってください。（2枚目画像）
端数処理方法は任意とします。
※結合セルには正の整数しか入っていません。

OK. A1から始まる表範囲のC列にある結合セルを解除し、結合されていた金額を均等に割り振るVBAコードを作成します。端数処理は、合計値から行数で割った商を基本とし、余りがあれば上から順に1ずつ加算する方法で実装します。

VBA


        
          
            Sub UnmergeAndDistributeAmount()


　　Dim ws As Worksheet

　　Dim lastRow As Long

　　Dim i As Long

　　Dim mergedRange As Range

　　Dim totalValue As Long

　　Dim numRows As Long

　　Dim startRow As Long

　　Dim baseValue As Long

　　Dim remainder As Long

　　Dim j As Long


　　'アクティブなシートを作業対象とする

　　'もし特定のシートを指定したい場合は、Sheets("シート名")などに変更してください

　　Set ws = ThisWorkbook.ActiveSheet


　　'C列の最終行を取得

　　lastRow = ws.Cells(Rows.Count, "C").End(xlUp).Row


　　'1行目から最終行までループ

　　i = 1

　　Do While i <= lastRow


　　　　'もしセルが結合されている場合

　　　　If ws.Cells(i, "C").MergeCells Then


　　　　　　'結合されている範囲を取得

　　　　　　Set mergedRange = ws.Cells(i, "C").MergeArea


　　　　　　'結合セルの値を取得（結合セルの左上のセルに値が入っている前提）

　　　　　　'ユーザーの指定により、正の整数のみを想定

　　　　　　totalValue = mergedRange.Cells(1, 1).Value


　　　　　　'結合されている行数を取得

　　　　　　numRows = mergedRange.Rows.Count


　　　　　　'結合範囲の開始行を取得

　　　　　　startRow = mergedRange.Row


　　　　　　'セルの結合を解除

　　　　　　mergedRange.Unmerge


　　　　　　'金額を均等に分配（整数）

　　　　　　baseValue = totalValue \ numRows '整数除算

　　　　　　remainder = totalValue Mod numRows '剰余


　　　　　　'元の結合範囲だったセルに値を割り振る

　　　　　　For j = startRow To startRow + numRows - 1

　　　　　　　　ws.Cells(j, "C").Value = baseValue


　　　　　　　　'余りがあれば上から順に1ずつ加算

　　　　　　　　If remainder > 0 Then

　　　　　　　　　　ws.Cells(j, "C").Value = ws.Cells(j, "C").Value + 1

　　　　　　　　　　remainder = remainder - 1

　　　　　　　　End If

　　　　　　Next j


　　　　　　'処理した結合範囲の最終行までiをスキップ

　　　　　　i = startRow + numRows


　　　　Else

　　　　　　'セルが結合されていない場合は次の行へ

　　　　　　i = i + 1

　　　　End If


　　Loop


　　MsgBox "処理が完了しました。", vbInformation


End Sub

コードの説明:

UnmergeAndDistributeAmount プロシージャを開始します。
作業対象のシートを ws 変数にセットします。（デフォルトではアクティブシート）
C列のデータが入っている最終行を取得します。
Do While ループを使って、1行目から最終行まで処理を進めます。
ループ内で、現在の行のC列のセル (ws.Cells(i, "C")) が結合されているかどうかを MergeCells プロパティで確認します。
もしセルが結合されていれば:
- MergeArea プロパティを使って、そのセルが含まれる結合範囲全体を取得します。
- 結合範囲の左上にあるセルの値 (mergedRange.Cells(1, 1).Value) を取得します。これが分配する合計金額です。
- 結合範囲の行数 (mergedRange.Rows.Count) を取得します。
- 結合範囲の開始行 (mergedRange.Row) を記録しておきます。
- Unmerge メソッドを使ってセルの結合を解除します。
- 合計金額を結合行数で整数除算し、baseValue（基本値）を計算します。
- 合計金額を結合行数で割った余りを remainder として計算します。
- 結合が解除された元の範囲の各行 (startRow から startRow + numRows - 1 まで) をループします。
- 各セルに baseValue を設定します。
- もし remainder が0より大きい場合は、そのセルに1を加え、remainder を1減らします。これにより、余りが上から順に分配されます。
- 結合範囲の処理が終わったら、メインのループカウンタ i を結合範囲の最終行の次の行に移動させ、すでに処理したセルを再度確認しないようにします。
もしセルが結合されていなければ、そのまま次の行に進むために i を1増やします。
ループが終了するまでこれを繰り返します。
処理完了のメッセージボックスを表示します。

使用方法:

Excelを開き、Alt + F11 キーを押してVBAエディターを開きます。
VBAエディターのメニューから「挿入」->「標準モジュール」を選択します。
開いた白いウィンドウに上記のコードを貼り付けます。
Excelシートに戻り、Alt + F8 キーを押してマクロダイアログを開きます。
UnmergeAndDistributeAmount を選択し、「実行」ボタンをクリックします。

これにより、A1から始まる表のC列にある結合セルが解除され、元の金額が均等に分配されます。

注意点:

このコードはC列のみを対象としています。
A1から表が始まっていることを前提としています。もし表が別のセルから始まる場合は、コード中の範囲指定などを適宜修正してください。
結合セルには正の整数のみが入っているというユーザーの前提に基づいて作成しています。想定外の値（文字列、エラー値など）が入っている場合は、エラーが発生する可能性があります。
アクティブシートを処理対象とします。特定のシートを処理したい場合は、コード中の Set ws = ThisWorkbook.ActiveSheet の行を Set ws = ThisWorkbook.Sheets("シート名") のように修正してください。

GeminiのVBA記述能力はすでにわかっていますが、、、
今回の問題は、一発で出題内容を理解していることに驚いています。
日本語の読解能力がすばらしいですね。

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

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

Geminiの回答 Geminiへの出題

VBA


        
          
            Attribute VB_Name = "Module1"

            '

            ' 目的: A1から始まる表範囲のC列にある結合セルを解除し、金額を均等に割り振る

            ' 前提: C列の結合セルには正の整数が入っていること

            '

            Sub DistributeMergedValues()


            　　' 画面更新と自動計算を停止し、処理速度を向上させる

            　　Application.ScreenUpdating = False

            　　Application.Calculation = xlCalculationManual


            　　' 対象となるシートを指定 (ここではアクティブシートを想定)

            　　Dim ws As Worksheet

            　　Set ws = ThisWorkbook.ActiveSheet ' 必要に応じてシート名を変更してください


            　　' A1を起点とした現在のデータ範囲を取得

            　　Dim dataRange As Range

            　　Set dataRange = ws.Range("A1").CurrentRegion


            　　' C列の最終行を取得

            　　Dim lastRow As Long

            　　lastRow = dataRange.Rows.Count


            　　' C列を上から順に処理

            　　Dim i As Long

            　　i = 1 ' ヘッダー行から開始する場合


            　　Do While i <= lastRow

            　　　　Dim currentCell As Range

            　　　　Set currentCell = dataRange.Cells(i, 3) ' C列


            　　　　' セルが結合されているか確認

            　　　　If currentCell.MergeCells Then

            　　　　　　' 結合されている場合、結合範囲全体を取得

            　　　　　　Dim mergeArea As Range

            　　　　　　Set mergeArea = currentCell.MergeArea


            　　　　　　' 結合セルの値と結合されている行数を取得

            　　　　　　Dim mergedValue As Long

            　　　　　　mergedValue = mergeArea.Cells(1, 1).Value ' 結合範囲の左上のセルの値を取得

            　　　　　　Dim mergeRows As Long

            　　　　　　mergeRows = mergeArea.Rows.Count


            　　　　　　' 結合を解除

            　　　　　　mergeArea.UnMerge


            　　　　　　' 値を均等に割り振るための基本値と剰余を計算

            　　　　　　Dim baseValue As Long

            　　　　　　baseValue = Int(mergedValue / mergeRows)

            　　　　　　Dim remainder As Long

            　　　　　　remainder = mergedValue Mod mergeRows


            　　　　　　' 結合されていた範囲に値を設定

            　　　　　　Dim j As Long

            　　　　　　For j = 0 To mergeRows - 1

            　　　　　　　　Dim targetCell As Range

            　　　　　　　　Set targetCell = mergeArea.Cells(j + 1, 1) ' 結合されていた範囲の各セル


            　　　　　　　　' 基本値を設定

            　　　　　　　　targetCell.Value = baseValue


            　　　　　　　　' 剰余を最初のセルから順に加算

            　　　　　　　　If j < remainder Then

            　　　　　　　　　　targetCell.Value = targetCell.Value + 1

            　　　　　　　　End If

            　　　　　　Next j


            　　　　　　' 処理した結合範囲の次の行から再開

            　　　　　　i = i + mergeRows

            　　　　Else

            　　　　　　' 結合されていない場合、次の行へ

            　　　　　　i = i + 1

            　　　　End If

            　　Loop


            　　' 画面更新と自動計算を元に戻す

            　　Application.ScreenUpdating = True

            　　Application.Calculation = xlCalculationAutomatic


            　　MsgBox "処理が完了しました。", vbInformation


            End Sub

VBAコードの解説

Attribute VB_Name = "Module1": 標準モジュールの名前を設定します。
Subプロシージャの定義: Sub DistributeMergedValues() としてプロシージャを開始します。このプロシージャは、C列の結合セルの値を均等に分配することを目的としています。
高速化のための設定:
- Application.ScreenUpdating = False: 画面の更新を停止し、VBAの実行速度を向上させます。
- Application.Calculation = xlCalculationManual: Excelの自動計算を手動に設定し、処理中の再計算を防ぎます。
ワークシートの指定:
- Dim ws As Worksheet: Worksheetオブジェクトを宣言します。
- Set ws = ThisWorkbook.ActiveSheet: 現在アクティブなシートを対象とします。必要に応じて ws = ThisWorkbook.Sheets("シート名") のように特定のシート名を指定することも可能です。
データ範囲の取得:
- Dim dataRange As Range: Rangeオブジェクトを宣言します。
- Set dataRange = ws.Range("A1").CurrentRegion: セルA1を起点とした現在のデータ領域（空白行・列で囲まれた範囲）を取得します。これにより、表全体の範囲を動的に取得できます。
最終行の取得:
- im lastRow As Long: Long型の変数を宣言します。
- lastRow = dataRange.Rows.Count: 取得したデータ範囲の行数を取得し、最終行とします。
ループ処理:
- Dim i As Long: 現在処理している行番号を保持する変数を宣言します。
- i = 1: データの開始行（ヘッダー行を含む場合）からループを開始します。データがA2から始まる場合は i = 2 とします。
- Do While i <= lastRow: i が最終行以下の間、ループを続行します。
- Set currentCell = dataRange.Cells(i, 3): 現在処理している行のC列のセルを取得します。dataRange.Cells(i, 3) は ws.Cells(dataRange.Row + i - 1, dataRange.Column + 3 - 1) と同等ですが、CurrentRegion内で相対的な位置を指定しています。
- 結合セルの判定: If currentCell.MergeCells Then で、現在のセルが結合セルの一部であるかを確認します。
- 結合セルの処理:
  - Set mergeArea = currentCell.MergeArea: セルが結合されている場合、その結合範囲全体を mergeArea として取得します。
  - mergedValue = mergeArea.Cells(1, 1).Value: 結合範囲の左上隅のセルの値を取得します。これが結合セル全体の合計金額です。
  - mergeRows = mergeArea.Rows.Count: 結合されている行数を取得します。
  - mergeArea.UnMerge: 取得した結合範囲の結合を解除します。
  - 値の分配計算:
    - baseValue = Int(mergedValue / mergeRows): 合計金額を結合されている行数で割り、小数点以下を切り捨てた基本値を計算します。
    - remainder = mergedValue Mod mergeRows: 合計金額を結合されている行数で割った余りを計算します。
  - 値の設定:
    - For j = 0 To mergeRows - 1: 結合されていた各行に対してループ処理を行います。
    - Set targetCell = mergeArea.Cells(j + 1, 1): 結合されていた範囲内の現在の行のセルを取得します。
    - targetCell.Value = baseValue: まず基本値を設定します。
    - If j < remainder Then targetCell.Value = targetCell.Value + 1: 剰余がある場合、最初の remainder 個のセルに1ずつ加算して端数を分配します。
  - i = i + mergeRows: 結合セル範囲の処理が終わった後、ループカウンタ i を結合されていた行数分だけ進め、処理済みの範囲をスキップします。
- 非結合セルの処理: Else i = i + 1: セルが結合されていない場合、次の行に進みます。
ループの終了: Loop で Do While ループを閉じます。
設定の復元:
- Application.ScreenUpdating = True: 画面更新を元に戻します。
- Application.Calculation = xlCalculationAutomatic: 自動計算を元に戻します。
完了メッセージ: MsgBox "処理が完了しました。", vbInformation で処理が正常に完了したことをユーザーに通知します。
End Sub: プロシージャを終了します。

このコードは、C列を効率的に走査し、結合セルを見つけたらその範囲をまとめて処理することで、パフォーマンスを考慮しています。Forループを完全に避けるのは結合セルの処理の性質上難しいですが、For Each を使う代わりに、行カウンタを明示的に操作して処理済みの結合範囲をスキップすることで、無駄な反復を減らしています。また、ExcelのRangeオブジェクトのMergeAreaやUnMergeメソッドを直接利用することで、簡潔なコードになっています。

VBAコードはデフォルトのGeminiと大きくは変わっていませんね。
しかし今回は突然に、
Attribute VB_Name = "Module1"
なんてものが入ってきてしまいました。
Attributeについては以下を参照してください。

VBAクラスのAttributeについて（既定メンバーとFor Each）

・VBAクラスのエクスポートとインポート・Attribute VB_PredeclaredId ・Attribute VB_Exposed ・Attribute [procName.]VB_Description ・Attribute variableName.VB_VarUserMemId ・Attribute procName.VB_UserMemId = 0 ・Attribute procName.VB_UserMemId = -4 ・VBAクラスのAttributeの最後に

このVBAをそのまま貼り付けるとAttributeがエラーになります。
この先頭のAttributeの行は消してください。
VBAのソースコードとしては間違いではないのですが、、、
こういうこともあるので、
AI出力のコードは貼り付けたときエラーが出る場合もあるということです。
エラー原因がわからない場合は、それもGeminiに聞いてみると良いです。

このように、ちゃんと教えてくれます。

AI神髄VBAへVBAコードの改良提案

AI神髄VBAにVBAコードの書き方を提案し、VBAコードを改良してみました。

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

結合範囲への値の設定するとき、Forループさせずに値を設定してください。

変更箇所だけの抜粋
VBA マクロ Gemini 100本ノック AI神髄VBA


        
          
            　　　　　　' --- ここから値設定をループなしで ---

　　　　　　' 結合されていた範囲全体に基本値を一括設定 (ループなし)

　　　　　　mergeArea.Value = baseValue


　　　　　　' 剰余があれば、最初の剰余個のセルに1を加算 (剰余分だけのループ)

　　　　　　If remainder > 0 Then

　　　　　　　　Dim k As Long

　　　　　　　　For k = 1 To remainder

　　　　　　　　　　' 結合されていた範囲のk番目のセルに1を加算

　　　　　　　　　　mergeArea.Cells(k, 1).Value = mergeArea.Cells(k, 1).Value + 1

　　　　　　　　Next k

　　　　　　End If

　　　　　　' --- ここまで値設定をループなし/最小限のループで ---

端数の設定でループさせているので、これではわざわざ変更する意味がありませんね。
といことで、さらに指示していきます。

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

端数もループを使わずに割り振ってください。

変更箇所だけの抜粋
VBA マクロ Gemini 100本ノック AI神髄VBA


        
          
            　　　　　　' --- ここから値設定を完全にループなしで ---

　　　　　　' 結合されていた範囲全体に基本値を一括設定 (ループなし)

　　　　　　mergeArea.Value = baseValue


　　　　　　' 剰余があれば、最初の剰余個のセルに1を加算 (ループなしのRange操作)

　　　　　　If remainder > 0 Then

　　　　　　　　' 結合されていた範囲の最初の 'remainder' 行を選択

　　　　　　　　Dim remainderRange As Range

　　　　　　　　Set remainderRange = mergeArea.Resize(remainder, 1)


　　　　　　　　' その範囲の値に1を加算して再度設定

　　　　　　　　remainderRange.Value = remainderRange.Value + 1

　　　　　　End If

　　　　　　' --- ここまで値設定を完全にループなしで ---

大したものです。
こちらの指示の意図をくみ取ってしっかり期待に応えてくれました。
もちろん、ループなしが必ずしも良いとは限りません。
しかし多くの場合、ループさせずに一括処理をすることで処理速度が大幅に改善されることが多いです。
今回はその練習ということで。

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

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

1.最終行の取得（End,Rows.Count）｜VBA入門
2.日本の祝日一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.Excelショートカットキー一覧｜Excelリファレンス
5.RangeとCellsの使い方｜VBA入門
6.FILTER関数（範囲をフィルター処理）｜エクセル入門
7.マクロとは？VBAとは？VBAでできること｜VBA入門
8.繰り返し処理（For Next)｜VBA入門
9.メッセージボックス(MsgBox関数)｜VBA入門
10.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門

ホーム
その他
生成AI活用研究
Geminiと100本ノック 12本目：セル結合の解除

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

記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。
This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.

生成AI活用研究
Geminiと100本ノック 12本目：セル結合の解除