生成AI活用研究
Geminiと100本ノック 25本目：マトリックス表をDB形式に変換

Geminiを中心に生成AIの活用と研究の記録
公開日：2025-05-27　最終更新日：2025-06-03

Geminiと100本ノック 25本目：マトリックス表をDB形式に変換


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


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

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


VBA100本ノックの出題と解答

VBA100本ノック 25本目：マトリックス表をDB形式に変換
・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ


Geminiへの出題とGeminiの回答

当初はGeminiの回答は、キャプチャ画像とそのテキストにしていましたが今回からはテキストのみにします。
Geminiの回答であるというエビデンスの意味でキャプチャを掲載していましたが、さすがにもう必要ないと思うので。

Geminiの回答 Geminiへの出題
VBA マクロ Geminiと100本ノック マトリックス表をDB形式に変換

VBA マクロ Geminiと100本ノック マトリックス表をDB形式に変換

VBA問題
画像1のように「売上」シートに横に日付と金額が入力されています。オンラインでベストセラーを購入
行数・列数(日数)は増減します。
A列はセル結合されています。
画像2のようにデータベース形式に変換して「売上DB」シートに出力してください。
※「売上DB」は既存で見出しも入っています。
承知いたしました。VBAで画像1の「売上」シートのデータを、画像2のようなデータベース形式に変換し、「売上DB」シートに出力するコードをご案内します。

このコードは、以下の点を考慮しています。

A列のセル結合に対応します。
行数・列数（日数）の増減に対応します。
「売上DB」シートは既存であり、見出しも入っているものとします。

VBA
Sub ConvertSalesToDB()

　　Dim wsSales As Worksheet
　　Dim wsSalesDB As Worksheet
　　Dim lastRowSales As Long
　　Dim lastColSales As Long
　　Dim i As Long
　　Dim j As Long
　　Dim dbRow As Long
　　Dim department As String
　　Dim category As String
　　Dim dateValue As Date
　　Dim amount As Long

　　' 各シートを設定
　　Set wsSales = ThisWorkbook.Sheets("売上")
　　Set wsSalesDB = ThisWorkbook.Sheets("売上DB")

　　' 売上DBシートの既存データをクリア（見出し行は残す）
　　With wsSalesDB
　　　　If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
　　　　　　.Range("A2:D" & .Cells(Rows.Count, "A").End(xlUp).Row).ClearContents
　　　　End If
　　End With

　　' 売上シートの最終行と最終列を取得
　　lastRowSales = wsSales.Cells(Rows.Count, "A").End(xlUp).Row
　　lastColSales = wsSales.Cells(1, Columns.Count).End(xlToLeft).Column

　　' 売上DBシートの書き込み開始行を設定
　　dbRow = 2 ' 見出しの次から開始

　　' 売上シートのデータをループ処理
　　For i = 2 To lastRowSales Step 2 ' データは2行セットなので、2行ずつスキップ

　　　　' 部門名を取得（結合セルに対応）
　　　　department = wsSales.Cells(i, "A").Value

　　　　' 実績と予算の2行を処理
　　　　For k = 0 To 1 ' 0:実績、1:予算

　　　　　　category = wsSales.Cells(i + k, "B").Value

　　　　　　' 日付と金額をループ処理
　　　　　　For j = 3 To lastColSales ' C列から日付が始まる

　　　　　　　　dateValue = wsSales.Cells(1, j).Value ' 1行目から日付を取得
　　　　　　　　amount = wsSales.Cells(i + k, j).Value ' 金額を取得

　　　　　　　　' 売上DBシートに書き込み
　　　　　　　　With wsSalesDB
　　　　　　　　　　.Cells(dbRow, "A").Value = department
　　　　　　　　　　.Cells(dbRow, "B").Value = category
　　　　　　　　　　.Cells(dbRow, "C").Value = dateValue
　　　　　　　　　　.Cells(dbRow, "D").Value = amount
　　　　　　　　End With
　　　　　　　　dbRow = dbRow + 1
　　　　　　Next j
　　　　Next k
　　Next i

　　' 売上DBシートの列幅を自動調整（任意）
　　wsSalesDB.Columns("A:D").AutoFit

　　MsgBox "データの変換が完了しました。", vbInformation

End Sub

コードの説明:
  • 変数の宣言: 必要な変数（ワークシートオブジェクト、最終行・列、ループカウンタなど）を宣言します。
  • シートの設定: 「売上」シートと「売上DB」シートをそれぞれ wsSales と wsSalesDB に設定します。
  • 売上DBシートの既存データクリア: wsSalesDB シートのA2セル以下にある既存データをクリアします。これにより、コードを実行するたびにデータが重複することを防ぎます。見出し行（1行目）は残します。
  • 最終行・列の取得:
    • lastRowSales = wsSales.Cells(Rows.Count, "A").End(xlUp).Row で、「売上」シートのA列の最終行を取得します。
    • lastColSales = wsSales.Cells(1, Columns.Count).End(xlToLeft).Column で、「売上」シートの1行目の最終列（日付の最終列）を取得します。
  • 書き込み開始行の設定: dbRow = 2 で、「売上DB」シートの書き込みを開始する行を2行目（見出しの次）に設定します。
  • 売上シートのループ処理:
    • For i = 2 To lastRowSales Step 2: 「売上」シートのデータは部門ごとに2行（実績、予算）で構成されているため、2行目から最終行まで2行ずつスキップしながらループします。
    • department = wsSales.Cells(i, "A").Value: A列は結合されているため、Cells(i, "A").Value で結合されているセルの一番上の値（部門名）を取得します。
    • For k = 0 To 1: 実績と予算の2つのカテゴリを処理するためにループします。k=0 の場合は実績、k=1 の場合は予算の行を指します。
    • category = wsSales.Cells(i + k, "B").Value: B列からカテゴリ（実績または予算）を取得します。
    • For j = 3 To lastColSales: C列（3列目）から最終列までループし、日付と金額を処理します。
    • dateValue = wsSales.Cells(1, j).Value: 1行目から日付を取得します。
    • amount = wsSales.Cells(i + k, j).Value: 各行の金額を取得します。
    • 取得した department、category、dateValue、amount を「売上DB」シートの対応する列に書き込みます。
    • dbRow = dbRow + 1: データが書き込まれるたびに「売上DB」シートの書き込み行を1つ増やします。
  • 列幅の自動調整: wsSalesDB.Columns("A:D").AutoFit で、「売上DB」シートのA列からD列までの列幅をデータに合わせて自動調整します（これは任意です）。
  • 完了メッセージ: 処理が完了したことを示すメッセージボックスを表示します。

使用方法:
  1. Excelを開き、Alt + F11 キーを押してVBAエディターを開きます。
  2. 左側のプロジェクトエクスプローラーで、VBAProject (ファイル名) の下にある Microsoft Excel Objects を展開し、ThisWorkbook をダブルクリックします。
  3. 開いたコードウィンドウに上記のVBAコードをコピー＆ペーストします。
  4. Excelに戻り、Alt + F8 キーを押してマクロダイアログを開きます。
  5. ConvertSalesToDB を選択し、「実行」をクリックします。

これで、「売上」シートのデータが「売上DB」シートに変換されて出力されます。

なぜか、変数「k」が未宣言です、どうしちゃったんでしょうか。
まあ、こういうこともあるんですね。
この程度の問題は、すぐにわかるし、AIでも直ぐに解決してくれます。
VBA マクロ Geminiと100本ノック マトリックス表をDB形式に変換

これ以外は問題なく、正しく動作します。


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

AI神髄VBAとは、GeminiのGems機能を使って作ったVBAに特化したカスタムAIです。
AI神髄VBAの回答 AI神髄VBAへの出題
VBA マクロ Geminiと100本ノック マトリックス表をDB形式に変換

VBA マクロ Geminiと100本ノック マトリックス表をDB形式に変換

VBA問題
画像1のように「売上」シートに横に日付と金額が入力されています。オンラインでベストセラーを購入
行数・列数(日数)は増減します。
A列はセル結合されています。
画像2のようにデータベース形式に変換して「売上DB」シートに出力してください。
※「売上DB」は既存で見出しも入っています。
VBA
Sub ConvertSalesToDB()
　　' 概要: 「売上」シートの横持ちデータを「売上DB」シートにデータベース形式で出力します。

　　Dim wsSales As Worksheet　　　　　' 「売上」シート
　　Dim wsSalesDB As Worksheet　　　　' 「売上DB」シート
　　Dim lastRowSales As Long　　　　　' 「売上」シートの最終行
　　Dim lastColSales As Long　　　　　' 「売上」シートの最終列
　　Dim dbRow As Long　　　　　　　　 ' 「売上DB」シートの出力開始行
　　Dim salesData As Variant　　　　　' 「売上」シートのデータ範囲を格納する配列
　　Dim outputArray As Variant　　　　' 「売上DB」シートに出力するデータを格納する配列
　　Dim r As Long　　　　　　　　　　 ' salesData配列の行インデックス
　　Dim c As Long　　　　　　　　　　 ' salesData配列の列インデックス
　　Dim currentRow As Long　　　　　　' outputArrayの現在の行インデックス

　　' ワークシートを設定
　　Set wsSales = ThisWorkbook.Sheets("売上")
　　Set wsSalesDB = ThisWorkbook.Sheets("売上DB")

　　' 画面更新とイベントを一時停止
　　Application.ScreenUpdating = False
　　Application.EnableEvents = False

　　On Error GoTo ErrorHandler

　　' 「売上」シートの最終行と最終列を取得
　　lastRowSales = wsSales.Cells(wsSales.Rows.Count, "A").End(xlUp).Row
　　lastColSales = wsSales.Cells(1, wsSales.Columns.Count).End(xlToLeft).Column

　　' データ範囲を配列に格納 (見出し行を除く)
　　' A1:部門, B1:区分, C1:2020/11/1, D1:2020/11/2, ...
　　' A2:部門1, B2:実績, C2:1163, D2:1458, ...
　　salesData = wsSales.Range(wsSales.Cells(1, "A"), wsSales.Cells(lastRowSales, lastColSales)).Value

　　' 出力用配列のサイズを概算
　　' (最終行 - 1) * (最終列 - 2) で行数を概算。部門と区分以外の列数分データが存在する
　　ReDim outputArray(1 To (UBound(salesData, 1) - 1) * (UBound(salesData, 2) - 2), 1 To 4)
　　currentRow = 1

　　' セル結合を解除し、データをフィルダウン
　　' A列のセル結合を解除し、結合されたセル範囲の値を下のセルにコピーする
　　For r = 2 To UBound(salesData, 1) Step 2 ' データは2行ずつ（実績、予算）なのでStep 2
　　　　If salesData(r, 1) = "" Then ' 結合セルの2行目以降（部門名が空白になっている行）
　　　　　　salesData(r, 1) = salesData(r - 1, 1) ' 上の行の部門名をコピー
　　　　End If
　　　　If salesData(r + 1, 1) = "" Then ' 予算行の部門名が空白になっている行
　　　　　　salesData(r + 1, 1) = salesData(r, 1) ' 上の行の部門名をコピー
　　　　End If
　　Next r

　　' データを行と日付ごとにループして出力配列に格納
　　' 最初の2列 (部門, 区分) は固定、3列目以降 (日付と金額) をループ
　　For r = 2 To UBound(salesData, 1) ' salesDataの2行目から最終行まで (データ行)
　　　　For c = 3 To UBound(salesData, 2) ' salesDataの3列目から最終列まで (日付と金額)
　　　　　　outputArray(currentRow, 1) = salesData(r, 1) ' 部門
　　　　　　outputArray(currentRow, 2) = salesData(r, 2) ' 区分
　　　　　　outputArray(currentRow, 3) = salesData(1, c)　 ' 日付 (1行目から取得)
　　　　　　outputArray(currentRow, 4) = salesData(r, c)　 ' 金額
　　　　　　currentRow = currentRow + 1
　　　　Next c
　　Next r

　　' 「売上DB」シートの既存データをクリア (見出し行は残す)
　　If wsSalesDB.Cells(wsSalesDB.Rows.Count, "A").End(xlUp).Row > 1 Then
　　　　wsSalesDB.Range("A2", wsSalesDB.Cells(wsSalesDB.Rows.Count, "D").End(xlUp)).ClearContents
　　End If

　　' 「売上DB」シートに配列を書き出し
　　' outputArrayの実際のデータ行数でReDim
　　ReDim Preserve outputArray(1 To currentRow - 1, 1 To 4)
　　wsSalesDB.Range("A2").Resize(UBound(outputArray, 1), UBound(outputArray, 2)).Value = outputArray

　　' 最終行を取得してセルの書式設定を調整
　　dbRow = wsSalesDB.Cells(wsSalesDB.Rows.Count, "A").End(xlUp).Row
　　wsSalesDB.Range("C2:C" & dbRow).NumberFormatLocal = "yyyy/m/d" ' 日付形式に設定
　　wsSalesDB.Range("D2:D" & dbRow).NumberFormatLocal = "#,##0"　　' 金額形式に設定

　　' 処理完了
　　MsgBox "データの変換が完了しました。", vbInformation

ErrorHandler:
　　' エラーが発生した場合
　　If Err.Number <> 0 Then
　　　　MsgBox "エラーが発生しました: " & Err.Description, vbCritical
　　End If

　　' 画面更新とイベントを再開
　　Application.ScreenUpdating = True
　　Application.EnableEvents = True

End Sub

VBAコードの解説
1. 概要と初期設定
  • Sub ConvertSalesToDB(): プロシージャ名で、売上データをデータベース形式に変換するという目的を明確にしています。
  • 変数の宣言:
    wsSales, wsSalesDB: それぞれ「売上」シートと「売上DB」シートを格納するWorksheetオブジェクト。
    lastRowSales, lastColSales: 「売上」シートのデータ範囲の最終行と最終列を格納するLong型変数。
    dbRow: 「売上DB」シートのデータ出力開始行を格納するLong型変数。
    salesData: 「売上」シートの全データを一度に読み込むためのVariant型配列。これにより、シートへのアクセス回数を大幅に削減し、高速化を図ります。
    outputArray: データベース形式に変換されたデータを一時的に格納するためのVariant型配列。
    r, c: salesData配列をループするためのインデックス変数。
    currentRow: outputArrayの現在の行位置を追跡するための変数。
  • Set wsSales = ThisWorkbook.Sheets("売上") / Set wsSalesDB = ThisWorkbook.Sheets("売上DB"): 処理対象のシートを設定します。
  • Application.ScreenUpdating = False / Application.EnableEvents = False: 処理中の画面のちらつきを抑え、イベント発生による不要な処理を防ぐために、画面更新とイベントを一時的に停止します。これにより、処理速度が向上します。
  • On Error GoTo ErrorHandler: エラーが発生した場合にErrorHandlerラベルにジャンプし、エラー処理を行うように設定します。
2. データ範囲の取得と配列への読み込み
  • lastRowSales = wsSales.Cells(wsSales.Rows.Count, "A").End(xlUp).Row: 「売上」シートのA列の最終使用行を取得します。
  • lastColSales = wsSales.Cells(1, wsSales.Columns.Count).End(xlToLeft).Column: 「売上」シートの1行目の最終使用列を取得します。
  • salesData = wsSales.Range(wsSales.Cells(1, "A"), wsSales.Cells(lastRowSales, lastColSales)).Value: 「売上」シートのA1セルから最終行・最終列までの全データ範囲をsalesData配列に一括で読み込みます。これにより、セルへの個別のアクセスが不要になり、処理速度が向上します。
3. セル結合の考慮とデータフィルダウン
  • 元の「売上」シートではA列が結合されているため、salesData配列に読み込むと、結合セルの2行目以降の「部門」が空白になります。
  • For r = 2 To UBound(salesData, 1) Step 2: salesData配列の2行目から最終行まで2行ずつループします。これは「実績」と「予算」のセットが2行で構成されているためです。
  • If salesData(r, 1) = "" Then salesData(r, 1) = salesData(r - 1, 1): もし現在の行のA列（部門）が空白であれば、直上の行（結合元のセル）の部門名をコピーして埋めます。これにより、後続の処理で部門名が正しく取得できるようになります。
  • If salesData(r + 1, 1) = "" Then salesData(r + 1, 1) = salesData(r, 1): 予算行の部門名が空白の場合も同様に埋めます。
4. 出力用配列の準備とデータ変換
  • ReDim outputArray(...): 出力用のoutputArrayを、最大で格納しうるデータ数に合わせて初期化します。行数は(UBound(salesData, 1) - 1) * (UBound(salesData, 2) - 2)で概算しています。これは、見出し行(-1)を除き、部門と区分以外の列数(-2)分データが存在するためです。列数は「部門」「区分」「日付」「金額」の4列です。
  • For r = 2 To UBound(salesData, 1): salesData配列の2行目（データ開始行）から最終行までループします。
  • For c = 3 To UBound(salesData, 2): salesData配列の3列目（日付データの開始列）から最終列までループします。
  • outputArray(currentRow, 1) = salesData(r, 1): salesDataの現在の行の部門名（A列）をoutputArrayの1列目（部門）に格納します。
  • outputArray(currentRow, 2) = salesData(r, 2): salesDataの現在の行の区分（B列）をoutputArrayの2列目（区分）に格納します。
  • outputArray(currentRow, 3) = salesData(1, c): salesDataの1行目（見出し行）の現在の列（日付）をoutputArrayの3列目（日付）に格納します。
  • outputArray(currentRow, 4) = salesData(r, c): salesDataの現在の行、現在の列（金額）をoutputArrayの4列目（金額）に格納します。
  • currentRow = currentRow + 1: outputArrayの次の行にデータを格納するためにインデックスをインクリメントします。
5. 「売上DB」シートへの出力
  • If wsSalesDB.Cells(wsSalesDB.Rows.Count, "A").End(xlUp).Row > 1 Then ... ClearContents: 「売上DB」シートに既存データがある場合、見出し行（1行目）以外のデータをクリアします。これにより、前回のデータが残ることを防ぎます。
  • ReDim Preserve outputArray(1 To currentRow - 1, 1 To 4): outputArrayは概算サイズで作成されているため、実際に格納されたデータ行数に合わせてサイズを調整します。これにより、不要な空行が出力されるのを防ぎます。
  • wsSalesDB.Range("A2").Resize(UBound(outputArray, 1), UBound(outputArray, 2)).Value = outputArray: outputArrayに格納された全データを、「売上DB」シートのA2セルを起点に一括で書き出します。配列の一括書き出しは、セルへの個別書き出しよりも非常に高速です。
  • wsSalesDB.Range("C2:C" & dbRow).NumberFormatLocal = "yyyy/m/d": 日付列（C列）の表示形式を日付形式に設定します。
  • wsSalesDB.Range("D2:D" & dbRow).NumberFormatLocal = "#,##0": 金額列（D列）の表示形式を数値形式（カンマ区切り）に設定します。
6. 終了処理
  • MsgBox "データの変換が完了しました。", vbInformation: 処理完了のメッセージを表示します。
  • ErrorHandler:: エラー発生時にジャンプするラベルです。
  • Application.ScreenUpdating = True / Application.EnableEvents = True: 処理の最後に、一時停止していた画面更新とイベントを再開します。
  • If Err.Number <> 0 Then MsgBox ...: エラーが発生していた場合、エラーメッセージを表示します。

このVBAコードは、シートとのやり取りを配列を介して行うことで、非常に高速な処理を実現しています。また、セル結合されたA列のデータを適切に処理し、データベース形式に変換する汎用性の高いコードとなっています。

エラーになってしまいます。
やはり配列を使うと、人間でもAIでもコードを間違えやすいようですね。

AI神髄VBAの回答 AI神髄VBAへの出題
VBA マクロ Geminiと100本ノック マトリックス表をDB形式に変換

VBA マクロ Geminiと100本ノック マトリックス表をDB形式に変換

エラーです。
画像ありがとうございます。エラーメッセージ「実行時エラー '9': インデックスが有効範囲にありません。」と、デバッグ箇所を見ると、salesData(r + 1, 1) の行でエラーが発生しているようです。

これは、For r = 2 To UBound(salesData, 1) Step 2 のループが、UBound(salesData, 1) (配列の最終行) に到達した際に、r + 1 が配列の範囲を超えてしまうために発生します。

「売上」シートのデータの行数が奇数だった場合、つまり最終行が「実績」行で終わっており「予算」行がない場合にこのエラーが発生します。Step 2でループしているため、最終の「実績」行（例えば最終行が11行目だとすると、r=11）でループが回り、その次の行をr+1で参照しようとしたときに、配列の範囲外になってしまうためです。

この問題を解決するには、ループの終端条件とデータ構造の仮定を見直す必要があります。

修正案

最も簡単な修正方法は、最終行が奇数行でも問題ないようにループの終端条件を調整することです。具体的には、salesData(r + 1, 1) を参照する前に、r + 1 が配列の範囲内であるかを確認する条件を追加します。

以下のコードに修正してください。

VBA
Sub ConvertSalesToDB()
　　' 概要: 「売上」シートの横持ちデータを「売上DB」シートにデータベース形式で出力します。

　　Dim wsSales As Worksheet　　　　　' 「売上」シート
　　Dim wsSalesDB As Worksheet　　　　' 「売上DB」シート
　　Dim lastRowSales As Long　　　　　' 「売上」シートの最終行
　　Dim lastColSales As Long　　　　　' 「売上」シートの最終列
　　Dim dbRow As Long　　　　　　　　 ' 「売上DB」シートの出力開始行
　　Dim salesData As Variant　　　　　' 「売上」シートのデータ範囲を格納する配列
　　Dim outputArray As Variant　　　　' 「売上DB」シートに出力するデータを格納する配列
　　Dim r As Long　　　　　　　　　　 ' salesData配列の行インデックス
　　Dim c As Long　　　　　　　　　　 ' salesData配列の列インデックス
　　Dim currentRow As Long　　　　　　' outputArrayの現在の行インデックス

　　' ワークシートを設定
　　Set wsSales = ThisWorkbook.Sheets("売上")
　　Set wsSalesDB = ThisWorkbook.Sheets("売上DB")

　　' 画面更新とイベントを一時停止
　　Application.ScreenUpdating = False
　　Application.EnableEvents = False

　　On Error GoTo ErrorHandler

　　' 「売上」シートの最終行と最終列を取得
　　lastRowSales = wsSales.Cells(wsSales.Rows.Count, "A").End(xlUp).Row
　　lastColSales = wsSales.Cells(1, wsSales.Columns.Count).End(xlToLeft).Column

　　' データ範囲を配列に格納 (見出し行を含む)
　　salesData = wsSales.Range(wsSales.Cells(1, "A"), wsSales.Cells(lastRowSales, lastColSales)).Value

　　' 出力用配列のサイズを概算
　　' (最終行 - 1) * (最終列 - 2) で行数を概算。部門と区分以外の列数分データが存在する
　　' もしデータが偶数行とは限らない場合を考慮し、最大値で見積もる
　　ReDim outputArray(1 To (UBound(salesData, 1) - 1) * (UBound(salesData, 2) - 2), 1 To 4)
　　currentRow = 1

　　' セル結合を解除し、データをフィルダウン
　　' A列のセル結合を解除し、結合されたセル範囲の値を下のセルにコピーする
　　' ループの範囲を最終行までとし、r + 1 の参照前にチェックを追加
　　For r = 2 To UBound(salesData, 1)
　　　　' 結合セルの2行目以降（部門名が空白になっている行）
　　　　If salesData(r, 1) = "" Then
　　　　　　salesData(r, 1) = salesData(r - 1, 1) ' 上の行の部門名をコピー
　　　　End If
　　Next r

　　' データを行と日付ごとにループして出力配列に格納
　　' 最初の2列 (部門, 区分) は固定、3列目以降 (日付と金額) をループ
　　For r = 2 To UBound(salesData, 1) ' salesDataの2行目から最終行まで (データ行)
　　　　For c = 3 To UBound(salesData, 2) ' salesDataの3列目から最終列まで (日付と金額)
　　　　　　outputArray(currentRow, 1) = salesData(r, 1) ' 部門
　　　　　　outputArray(currentRow, 2) = salesData(r, 2) ' 区分
　　　　　　outputArray(currentRow, 3) = salesData(1, c)　 ' 日付 (1行目から取得)
　　　　　　outputArray(currentRow, 4) = salesData(r, c)　 ' 金額
　　　　　　currentRow = currentRow + 1
　　　　Next c
　　Next r

　　' 「売上DB」シートの既存データをクリア (見出し行は残す)
　　If wsSalesDB.Cells(wsSalesDB.Rows.Count, "A").End(xlUp).Row > 1 Then
　　　　wsSalesDB.Range("A2", wsSalesDB.Cells(wsSalesDB.Rows.Count, "D").End(xlUp)).ClearContents
　　End If

　　' 「売上DB」シートに配列を書き出し
　　' outputArrayの実際のデータ行数でReDim
　　ReDim Preserve outputArray(1 To currentRow - 1, 1 To 4)
　　wsSalesDB.Range("A2").Resize(UBound(outputArray, 1), UBound(outputArray, 2)).Value = outputArray

　　' 最終行を取得してセルの書式設定を調整
　　dbRow = wsSalesDB.Cells(wsSalesDB.Rows.Count, "A").End(xlUp).Row
　　wsSalesDB.Range("C2:C" & dbRow).NumberFormatLocal = "yyyy/m/d" ' 日付形式に設定
　　wsSalesDB.Range("D2:D" & dbRow).NumberFormatLocal = "#,##0"　　' 金額形式に設定

　　' 処理完了
　　MsgBox "データの変換が完了しました。", vbInformation

ErrorHandler:
　　' エラーが発生した場合
　　If Err.Number <> 0 Then
　　　　MsgBox "エラーが発生しました: " & Err.Description, vbCritical
　　End If

　　' 画面更新とイベントを再開
　　Application.ScreenUpdating = True
　　Application.EnableEvents = True

End Sub

修正点の解説
  1. セル結合処理のループの変更:
    • 変更前: For r = 2 To UBound(salesData, 1) Step 2
    • 変更後: For r = 2 To UBound(salesData, 1)
    • セル結合解除とフィルダウンの処理を、Step 2ではなく1行ずつループするように変更しました。これにより、奇数行で終わるデータでも最終行のA列の処理が正常に行われます。
    • また、salesData(r + 1, 1) の参照自体が不要になったため、インデックス範囲外エラーが発生しなくなります。結合されたA列のデータは、必ず上の行に値が入っているので、salesData(r, 1) = salesData(r - 1, 1) の処理だけで十分です。

この修正により、データの最終行が偶数行か奇数行かに関わらず、部門名が正しくフィルダウンされ、その後のデータ変換が問題なく行われるようになります。

今度は、結果が正しくしくないですね。
こういう数値の転記では、まず最初に総合計を確認するようにします。
これは、セル範囲を選択すれば、オートカルクで確認できます。

AI神髄VBAの回答 AI神髄VBAへの出題
部門5の予算が出力されていません。
ご連絡ありがとうございます。部門5の予算が出力されていないとのこと、失礼いたしました。

原因は、A列の結合セルに対するフィルダウン処理の誤りです。前回の修正でStep 2を削除し、すべての行をループするように変更しましたが、これにより「実績」と「予算」のグループで「部門」が正確にコピーされなくなっていました。

画像を見ると、部門名は「実績」行のA列にのみ入力されており、「予算」行のA列は結合セルによって空白になっています。これを配列に読み込んだ際、salesData(r, 1) は結合セルの2行目（予算行）で空白になるため、前回の修正だと「予算」行の部門が適切に埋められず、結果として部門が関連付けられずに出力されないか、または間違った部門が関連付けられる可能性があります。

根本的な原因と修正方針:
  • 「部門」は結合セルですが、配列に読み込んだ時点で結合は解除された状態になり、結合セル内の最初のセルにのみ値が入ります。つまり、「部門1 実績」の行（例えば2行目）のsalesData(2, 1)には"部門1"が入りますが、「部門1 予算」の行（3行目）のsalesData(3, 1)は""（空白）になります。
  • このため、salesData配列に読み込んだ後、A列の空白になっている部分に正しい部門名を埋める処理が必要です。
以下のコードに修正してください。

VBA
Sub ConvertSalesToDB()
　　' 概要: 「売上」シートの横持ちデータを「売上DB」シートにデータベース形式で出力します。

　　Dim wsSales As Worksheet　　　　　' 「売上」シート
　　Dim wsSalesDB As Worksheet　　　　' 「売上DB」シート
　　Dim lastRowSales As Long　　　　　' 「売上」シートの最終行
　　Dim lastColSales As Long　　　　　' 「売上」シートの最終列
　　Dim dbRow As Long　　　　　　　　 ' 「売上DB」シートの出力開始行
　　Dim salesData As Variant　　　　　' 「売上」シートのデータ範囲を格納する配列
　　Dim outputArray As Variant　　　　' 「売上DB」シートに出力するデータを格納する配列
　　Dim r As Long　　　　　　　　　　 ' salesData配列の行インデックス
　　Dim c As Long　　　　　　　　　　 ' salesData配列の列インデックス
　　Dim currentRow As Long　　　　　　' outputArrayの現在の行インデックス
　　Dim currentDept As String　　　　 ' 現在処理中の部門名を保持する変数

　　' ワークシートを設定
　　Set wsSales = ThisWorkbook.Sheets("売上")
　　Set wsSalesDB = ThisWorkbook.Sheets("売上DB")

　　' 画面更新とイベントを一時停止
　　Application.ScreenUpdating = False
　　Application.EnableEvents = False

　　On Error GoTo ErrorHandler

　　' 「売上」シートの最終行と最終列を取得
　　lastRowSales = wsSales.Cells(wsSales.Rows.Count, "A").End(xlUp).Row
　　lastColSales = wsSales.Cells(1, wsSales.Columns.Count).End(xlToLeft).Column

　　' データ範囲を配列に格納 (見出し行を含む)
　　salesData = wsSales.Range(wsSales.Cells(1, "A"), wsSales.Cells(lastRowSales, lastColSales)).Value

　　' 出力用配列のサイズを概算
　　' (最終行 - 1) * (最終列 - 2) で行数を概算。部門と区分以外の列数分データが存在する
　　ReDim outputArray(1 To (UBound(salesData, 1) - 1) * (UBound(salesData, 2) - 2), 1 To 4)
　　currentRow = 1

　　' salesData配列のA列の結合セルによる空白をフィルダウンして埋める
　　' この処理を最初に行うことで、後のループで部門名が常に取得できるようにする
　　For r = 2 To UBound(salesData, 1)
　　　　If salesData(r, 1) <> "" Then ' もし部門名が入力されていれば (結合セルの先頭行)
　　　　　　currentDept = salesData(r, 1) ' その部門名を保持
　　　　Else ' 部門名が空白であれば (結合セルの2行目以降)
　　　　　　salesData(r, 1) = currentDept ' 保持していた部門名をコピー
　　　　End If
　　Next r

　　' データを行と日付ごとにループして出力配列に格納
　　' 最初の2列 (部門, 区分) は固定、3列目以降 (日付と金額) をループ
　　For r = 2 To UBound(salesData, 1) ' salesDataの2行目から最終行まで (データ行)
　　　　For c = 3 To UBound(salesData, 2) ' salesDataの3列目から最終列まで (日付と金額)
　　　　　　' 金額データが空白の場合はスキップする (完全な空白行や列への対応)
　　　　　　If Not IsEmpty(salesData(r, c)) Then
　　　　　　　　outputArray(currentRow, 1) = salesData(r, 1)　 ' 部門
　　　　　　　　outputArray(currentRow, 2) = salesData(r, 2)　 ' 区分
　　　　　　　　outputArray(currentRow, 3) = salesData(1, c)　 ' 日付 (1行目から取得)
　　　　　　　　outputArray(currentRow, 4) = salesData(r, c)　 ' 金額
　　　　　　　　currentRow = currentRow + 1
　　　　　　End If
　　　　Next c
　　Next r

　　' 「売上DB」シートの既存データをクリア (見出し行は残す)
　　If wsSalesDB.Cells(wsSalesDB.Rows.Count, "A").End(xlUp).Row > 1 Then
　　　　wsSalesDB.Range("A2", wsSalesDB.Cells(wsSalesDB.Rows.Count, "D").End(xlUp)).ClearContents
　　End If

　　' 出力するデータが全くない場合（currentRowが1のまま）は処理をスキップ
　　If currentRow = 1 Then
　　　　MsgBox "出力するデータがありませんでした。", vbInformation
　　　　GoTo CleanUp
　　End If

　　' 「売上DB」シートに配列を書き出し
　　' outputArrayの実際のデータ行数でReDim
　　ReDim Preserve outputArray(1 To currentRow - 1, 1 To 4)
　　wsSalesDB.Range("A2").Resize(UBound(outputArray, 1), UBound(outputArray, 2)).Value = outputArray

　　' 最終行を取得してセルの書式設定を調整
　　dbRow = wsSalesDB.Cells(wsSalesDB.Rows.Count, "A").End(xlUp).Row
　　wsSalesDB.Range("C2:C" & dbRow).NumberFormatLocal = "yyyy/m/d" ' 日付形式に設定
　　wsSalesDB.Range("D2:D" & dbRow).NumberFormatLocal = "#,##0"　　' 金額形式に設定

　　' 処理完了
　　MsgBox "データの変換が完了しました。", vbInformation

CleanUp: ' 正常終了およびエラー発生時のクリーンアップ処理のラベル

ErrorHandler:
　　' エラーが発生した場合
　　If Err.Number <> 0 Then
　　　　MsgBox "エラーが発生しました: " & Err.Description, vbCritical
　　End If

　　' 画面更新とイベントを再開
　　Application.ScreenUpdating = True
　　Application.EnableEvents = True

End Sub

修正点の解説
  1. A列のフィルダウン処理の強化:
    • currentDept As String 変数の追加: 現在処理している部門名を一時的に保持するための変数です。
      フィルダウンロジックの修正:
      VBA
      For r = 2 To UBound(salesData, 1)
      　　If salesData(r, 1) <> "" Then ' もし部門名が入力されていれば (結合セルの先頭行)
      　　　　currentDept = salesData(r, 1) ' その部門名を保持
      　　Else ' 部門名が空白であれば (結合セルの2行目以降)
      　　　　salesData(r, 1) = currentDept ' 保持していた部門名をコピー
      　　End If
      Next r

      このループは、salesData配列を上から順に1行ずつ走査します。
      • もしsalesData(r, 1)（現在の行のA列）に値があれば、それは結合セルの最初の行なので、その値をcurrentDeptに保存します。
      • もしsalesData(r, 1)が空白であれば、それは結合セルの2行目以降（例: 予算行）なので、currentDeptに保存されている最新の部門名をsalesData(r, 1)にコピーして埋めます。
    • この処理をデータ変換のメインループの前に独立して行うことで、後続の変換処理で常に正しい部門名がsalesData(r, 1)から取得できるようになります。
  2. 空白データのスキップ処理の追加 (任意ですが推奨):
    • If Not IsEmpty(salesData(r, c)) Then ... End If: データをoutputArrayに格納する際に、対応する金額データが空白でないことを確認する条件を追加しました。これにより、もし「売上」シートに金額が入力されていないセルがあった場合、そのデータは「売上DB」シートに出力されなくなります。これにより、不完全なデータが出力されるのを防ぎ、よりクリーンなデータベースを作成できます。
  3. 出力データがない場合のメッセージ追加:
    • If currentRow = 1 Then MsgBox "出力するデータがありませんでした。", vbInformation: outputArrayにデータが全く格納されなかった場合（currentRowが初期値の1のままの場合）に、その旨をユーザーに通知し、不必要なエラーや空のシート出力になるのを防ぎます。

この修正により、部門のセル結合を考慮した正確なデータフィルダウンが行われ、部門5の予算データも正しく「売上DB」シートに出力されるはずです。お手数ですが、再度このコードでお試しいただけますでしょうか。

これなら問題なく動くようです。



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

Geminiと100本ノック 18本目：名前定義の削除
Geminiと100本ノック 19本目：図形のコピー
Geminiと100本ノック 20本目：ブックのバックアップ
Geminiと100本ノック 21本目：バックアップファイルの削除
Geminiと100本ノック 22本目：FizzBuzz発展問題
Geminiと100本ノック 23本目：シート構成の一致確認
Geminiと100本ノック 24本目：全角英数のみ半角
Geminiと100本ノック 25本目：マトリックス表をDB形式に変換
生成AIと100本ノック 26本目：ファイル一覧作成
生成AIと100本ノック 27本目：ハイパーリンクのURL
生成AIと100本ノック 26本目：ファイル一覧作成


新着記事NEW ・・・新着記事一覧を見る

エクセル関数辞典 AI版｜エクセル入門（6月10日）
生成AIと100本ノック 28本目：シートをブックに分割｜生成AI活用研究（6月8日）
生成AIと脱Excelの時代：ブラックボックスと共に進む知的変革｜生成AI活用研究(2025-06-08)
生成AIと100本ノック 27本目：ハイパーリンクのURL｜生成AI活用研究（6月7日）
生成AIと100本ノック 26本目：ファイル一覧作成｜生成AI活用研究（6月6日）
AI時代のプログラミング再考：記述の自由と知の民主化｜生成AI活用研究(2025-06-06)
Excel×スプレッドシート連携：HTTP GETで学ぶGAS API設計入門｜生成AI活用研究(2025-06-04)
AI×ひらめき ― 「ネタ」が飛躍する創造の増幅プロセス｜生成AI活用研究(2025-06-03)
Googleカレンダーの日本の祝日をGASとExcelで取得する ～APIキー不要、XML連携ガイド～｜生成AI活用研究(2025-06-02)
究極のVBA転記プロンプト公開！あなたの事務作業を劇的に効率化｜生成AI活用研究(2025-06-02)


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

1.最終行の取得（End,Rows.Count）｜VBA入門
2.変数宣言のDimとデータ型｜VBA入門
3.繰り返し処理（For Next)｜VBA入門
4.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
5.RangeとCellsの使い方｜VBA入門
6.FILTER関数（範囲をフィルター処理）｜エクセル入門
7.メッセージボックス(MsgBox関数)｜VBA入門
8.セルのクリア（Clear,ClearContents）｜VBA入門
9.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
10.マクロとは？VBAとは？VBAでできること｜VBA入門



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


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

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ
同じテーマの記事
新着記事
アクセスランク


↑