VBA練習問題
VBA100本ノック 42本目:データベース形式に変換

VBAを100本の練習問題で鍛えます
最終更新日:2021-07-12

VBA100本ノック 42本目:データベース形式に変換


階層構造で入力されているシートをデータベース形式に変換する問題です。


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

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。
マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。


出題

出題ツイートへのリンク

#VBA100本ノック 42本目
画像1のように「階層」シートに階層を表したデータがあります。
これを画像2のように「階層DB」シートにデータベース形式に変換して出力してください。

マクロ VBA 100本ノック

マクロ VBA 100本ノック


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


VBA作成タイム

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


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


頂いた回答

解説

手動でやるなら、
・A:C列選択、Ctrl+Gのセルの選択で空白選択
・=↑、Ctrl+Enter
・A:C列選択、Ctrl+C、値張り付け
・D列選択、Ctrl+Gのセルの選択で空白選択
・セル削除、行全体
これをVBAで書いてみます。

Sub VBA100_42_01()
  Dim ws階層 As Worksheet, ws階層DB As Worksheet
  Set ws階層 = Worksheets("階層DB")
  Set ws階層DB = Worksheets("階層DB")
  
  ws階層.Cells.Copy Destination:=ws階層DB.Cells
  
  On Error Resume Next '念の為のSpecialCells対応
  With ws階層DB.Range("A1").CurrentRegion
    .Columns("A:C").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    .Columns("A:C").Value = .Columns("A:C").Value
    .Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  End With
End Sub


1行ずつ処理していく方法も考え方としては良いですし、重要な考え方になります。
A:C列については、空白以外で値が入っていたらその値を退避しておき、詳細行になった時点で出力します。
これは記事補足に掲載しました。


補足

省略されている値を埋める方法として、直前の値を使うという処理はVBAでは時々発生します。
A:C列については、空白以外で値が入っていたらその値を退避しておき、詳細行になった時点で出力します。
件数が多ければ処理時間もかかりますし、まどろっこしく感じてしまいますが、VBA処理の考え方としては是非覚えておきたいものです。

Sub VBA100_42_02()
  Dim ws階層 As Worksheet, ws階層DB As Worksheet
  Set ws階層 = Worksheets("階層")
  Set ws階層DB = Worksheets("階層DB")
  
  ws階層DB.Range("A1").CurrentRegion.Offset(1).ClearContents
  
  Dim i As Long, j As Long, A, B, C
  j = 2
  With ws階層
    For i = 2 To .Cells(.Rows.Count, "D").End(xlUp).Row
      If .Cells(i, 1) <> "" Then A = .Cells(i, 1).Value
      If .Cells(i, 2) <> "" Then B = .Cells(i, 2).Value
      If .Cells(i, 3) <> "" Then C = .Cells(i, 3).Value
      If .Cells(i, 4) <> "" Then
        ws階層DB.Cells(j, 1).Resize(, 4).Value = Array(A, B, C, .Cells(i, 4))
        j = j + 1
      End If
    Next
  End With
End Sub


上記では、出力は1行まとめていますが、それでも件数が多くなると処理時間がかかりそうです。
入力範囲も一度に配列に取得し、出力も配列で一括で出力するようにすればかなり高速に処理できます。

Sub VBA100_42_03()
  Dim ws階層 As Worksheet, ws階層DB As Worksheet
  Set ws階層 = Worksheets("階層")
  Set ws階層DB = Worksheets("階層DB")
  
  ws階層DB.Range("A1").CurrentRegion.Offset(1).ClearContents
  
  Dim inAry, outAry, tmpAry
  With ws階層.Range("A1").CurrentRegion
    inAry = Intersect(.Cells, .Offset(1))
  End With
  ReDim outAry(LBound(inAry, 1) To UBound(inAry, 1), LBound(inAry, 2) To UBound(inAry, 2))
  ReDim tmpAry(LBound(inAry, 2) To UBound(inAry, 2))
  
  Dim i As Long, j As Long, jj As Long, k As Long
  k = LBound(inAry, 1)
  With ws階層
    For i = LBound(inAry, 1) To UBound(inAry, 1)
      For j = LBound(inAry, 2) To UBound(inAry, 2)
        If inAry(i, j) <> "" Then
          tmpAry(j) = inAry(i, j)
          '下位項目を消去
          For jj = j + 1 To UBound(inAry, 2)
            tmpAry(jj) = ""
          Next
        End If
      Next
      If inAry(i, UBound(inAry, 2)) <> "" Then
        For j = LBound(inAry, 2) To UBound(inAry, 2)
          outAry(k, j) = tmpAry(j)
        Next
        k = k + 1
      End If
    Next
  End With
  
  ws階層DB.Range("A2").Resize(UBound(outAry, 1) - LBound(outAry, 1) + 1, _
              UBound(outAry, 2) - LBound(outAry, 2) + 1) = outAry
End Sub

上記VBAでは、小項目が省略されたような場合(出題の表で12行目や17行目が無い場合)、
小項目が空欄になるように、下位項目をクリアする処理を入れています。


サイト内関連ページ

第16回.繰り返し処理(For Next)
VBAのForNextは、同じ処理を繰り返し行うためのVBA構文です。繰り返し処理はループ処理とも呼ばれます。マクロでのループ処理の記述は何通りかありますが、まず最初に覚えるべきものが、今回説明するForNextです。
第17回.繰り返し処理(Do Loop)
繰り返し処理として前回はFor~Nextをやりました。今回はDo~Loopです。For~Nextに比べると使用頻度は落ちますが、必ず覚える必要があるものです。For~Nextは、繰り返す回数をあらかじめ指定するものでしたが、Do~Loopは、繰り返す回数ではなく、繰り返す条件を指定するものです。
第18回.最終行の取得(End,Rows.Count)
Excelワークシートにおける表の最終行の取得は、マクロVBAの必須技術になります、エクセルVBAにおける最終行取得の必要性 エクセルは表計算ソフトです、つまり縦横の表を扱います、データは横に項目があり、縦に項目に対するデータが入っている事が一般的です。しかし、そのデータ行数は決まった行数ではない事が普通です。




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

39本目:数値リストの統合(マージ)
40本目:複数ブックの統合
41本目:暗算練習アプリ
42本目:データベース形式に変換
43本目:CSV出力
44本目:全テーブル一覧作成
45本目:テーブルに列追加
46本目:名前定義に使える文字
47本目:Window操作
48本目:配列と数値型
49本目:条件付き書式の判定


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

還暦のVBA:VBAまでたどりつけるか… (2021-09-29)
VLOOKUPを使うことを基本としてシートを設計すべきか|エクセル雑感(2021-08-17)
コンピューターはブラックボックスで良い|エクセル雑感(2021-08-14)
小文字"abc"を大文字"ABC"に変換する方法|エクセル雑感(2021-08-13)
ADOでテキストデータを集計する|VBAサンプル集(2021-08-04)
VBA学習のお勧めコース|エクセル雑感(2021-08-01)
エクセル馬名ダービー|エクセル雑感(2021-07-21)
在庫を減らせ!毎日棚卸ししろ!|エクセル雑感(2021-07-05)
日付型と通貨型のValueとValue2について|エクセル雑感(2021-06-26)
DXってなんだ? ITと何が違うの?|エクセル雑感(2021-06-24)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.Excelショートカットキー一覧|Excelリファレンス
3.変数宣言のDimとデータ型|VBA入門
4.RangeとCellsの使い方|VBA入門
5.繰り返し処理(For Next)|VBA入門
6.マクロって何?VBAって何?|VBA入門
7.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
8.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
9.セルに文字を入れるとは(Range,Value)|VBA入門
10.並べ替え(Sort)|VBA入門




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


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



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