VBA100本ノック 74本目：1シート複数表をDB形式に変換

最終更新日：2021-02-22

VBA100本ノック 74本目：1シート複数表をDB形式に変換

1シートで取引先ごとに別表になっているデータをまとめてDB形式に出力する問題です。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。

マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。

出題

#VBA100本ノック 74本目
「売上」シートには、A列B列に取引先コードと名称があり、その下に見出し行から始まるデータがあります。
「DB」シートにデータベース形式で出力してください。
見出し行は文字列も含め統一されています。
取引先ごとの行数は不定です。
※「DB」は既存で見出しも書式も設定済

サンプルファイルです。
https://excel-ubara.com/vba100sample/VBA100_74.xlsm
https://excel-ubara.com/vba100sample/VBA100_74.zip

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

この処理は書き方が人それぞれ様々だと思います。
どのセルをどのように判定して各行を決定するか、シートの状態から判断することになります。
絶対的な正解はありませんので、まずはサンプルが処理出来れば良いと思います。
さらには、できれば多少のレイアウト変更にも対応したいところです。


  
    
      Sub VBA100_74_01()

　　Dim ws売上 As Worksheet: Set ws売上 = Worksheets("売上")

　　Dim wsDB As Worksheet:　 Set wsDB = Worksheets("DB")

　　wsDB.Range("A1").CurrentRegion.Offset(1).ClearContents

　　

　　Dim tCd As String　　　 '取引先CD

　　Dim tName As String　　 '取引先名

　　Dim i As Long　　　　　 '売上の行

　　Dim j As Long　　　　　 '売上の列

　　Dim ix As Long　　　　　'見出し行

　　Dim maxRow As Long　　　'最終行

　　Dim maxCol As Long　　　'最終列

　　Dim oRow As Long　　　　'DBの行

　　Dim ary(1 To 6)　　　　 '出力1行分の配列

　　

　　'シートの最終行列の取得：とりあえず全部調べようという事

　　maxRow = ws売上.Cells.SpecialCells(xlCellTypeLastCell).Row

　　maxCol = ws売上.Cells.SpecialCells(xlCellTypeLastCell).Column

　　

　　oRow = 2

　　For i = 1 To maxRow

　　　　Select Case True

　　　　　　Case ws売上.Cells(i, 1) = ""

　　　　　　　　'空行

　　　　　　Case ws売上.Cells(i, 3) = ""

　　　　　　　　'取引先の行

　　　　　　　　tCd = ws売上.Cells(i, 1)　　　　　　　　'取引先CD

　　　　　　　　tName = ws売上.Cells(i, 2)　　　　　　　'取引先名

　　　　　　Case ws売上.Cells(i, 1) Like "商品*"

　　　　　　　　'見出し行

　　　　　　　　ix = i　　　　　　　　　　　　　　　　　'見出し行の退避

　　　　　　Case Else

　　　　　　　　'データ行

　　　　　　　　For j = 3 To maxCol

　　　　　　　　　　If IsDate(ws売上.Cells(ix, j)) Then '四半期計は除外

　　　　　　　　　　　　ary(1) = tCd　　　　　　　　　　'取引先CD

　　　　　　　　　　　　ary(2) = tName　　　　　　　　　'取引先名

　　　　　　　　　　　　ary(3) = ws売上.Cells(i, 1)　　 '商品CD

　　　　　　　　　　　　ary(4) = ws売上.Cells(i, 2)　　 '商品名

　　　　　　　　　　　　ary(5) = ws売上.Cells(ix, j)　　'年月

　　　　　　　　　　　　ary(6) = ws売上.Cells(i, j)　　 '金額

　　　　　　　　　　　　wsDB.Cells(oRow, 1).Resize(, 6) = ary

　　　　　　　　　　　　oRow = oRow + 1 '出力行を次へ

　　　　　　　　　　End If

　　　　　　　　Next

　　　　End Select

　　Next

End Sub

決してこれが正解という事ではなく、私なりの処理にしてみたという事です。
空行の有無や四半期計の有無、これらの自由度を少し高めてみました。
VBAにコメントを細かく入れたので、解説の代わりとします。
記事にVBAを掲載しています。

補足

補足はありません。

サイト内関連ページ

第16回．繰り返し処理（For Next）

・For Next ステートメント・For Next 例文・For Next をステップイン実行で目で見て確認しましょう。・１行置きに処理する場合・Exit For ・For～Nextのネスト（入れ子）・最後に一言

第17回．繰り返し処理（Do Loop）

・Do～Loopの構文・条件式・Do Loop 例文・Exit Do ・Do～Loopのネスト（入れ子）・最後に一言

第18回．最終行の取得（End,Rows.Count）

・エクセルVBAにおける最終行取得の必要性・.End(xlDown)：Ctrl+↓ ・.End(xlUp)：Ctrl+↑ ・Endプロパティの方向（↑↓←→）について・セルの行数を取得するRowプロパティ・Cells(Rows.Count, 1).End(xlUp).Rowを日本語に訳す・EndプロパティがRangeオブジェクトを返す・Endプロパティの問題点・最終行に関するサイト内のページ

最終行・最終列の取得方法（End,CurrentRegion,SpecialCells,UsedRange）

・最終行取得の基本：手動ではCtrl + ↑、VBAではCells(1, 1).End(xlDown) ・最終列の取得・特殊な表の場合・CurrentRegion ・SpecialCells(xlCellTypeLastCell) ・UsedRange ・Findメソッド・サイト内関連ページ

同じテーマ「VBA100本ノック」の記事

71本目：パワーポイントへグラフを貼り付け
 72本目：ITをDXに変換（文字列操作）
73本目：新規ブックにボタン作成しマクロ登録
74本目：1シート複数表をDB形式に変換
75本目：ログインフォームの作成
 76本目：ボタンの表示名の位置へ移動
 77本目：シート挿入イベント
 78本目：グラフのデータ範囲拡張
 79本目：Wordにセル範囲を図として挿入
 80本目：読み取り専用で保存できないブックにする
 81本目：全フィルターの絞り込解除

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

1.最終行の取得（End,Rows.Count）｜VBA入門
2.RangeとCellsの使い方｜VBA入門
3.繰り返し処理（For Next)｜VBA入門
4.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
5.変数宣言のDimとデータ型｜VBA入門
6.マクロとは？VBAとは？VBAでできること｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.条件分岐（IF）｜VBA入門
9.並べ替え（Sort）｜VBA入門
10.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
74本目：1シート複数表をDB形式に変換

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

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

VBA練習問題
VBA100本ノック 74本目：1シート複数表をDB形式に変換