VBAを使った別ブックからのデータ転記の際に使えるステートメント、関数、配列について紹介します。
今回は、私が実務でよく行っているGoogleフォームのダウンロードデータの転記作業を事例に下記のうち列挙型Enumについて解説していきます。
■データ転記に使用するステートメント・関数・配列
- Enumステートメント
- LEFT関数、Mid関数
- InStr関数
- Join関数
- 配列
サンプルデータを使ってコードを確認したい方はこちら
作業の概要
Googleフォームのダウンロードデータ（転記元ファイル）からExcelの規定フォームへの転記
作業の流れ
- Googleフォームから吐き出されたCSVを開く
転記元ファイルが単数・複数にも対応できるようにFileDialogオブジェクトを使います。 - ダウンロードデータ（転記元ファイル）の最終行を取得して、ForNextステートメントで1行・１列ずつ転記していく
FileDialogオブジェクトについてはこちら↓
VBAファイルを開く方法まとめ②
Application内のFileDialogオブジェクトについて、プロパティ、メソッドの活用方法をコードを使って紹介しています。
ym-pc.com
2023.09.17
ForNextステートメントについてはこちら↓
10日で習得！VBA入門⑥繰り返し処理と最終行数取得
今回は繰り返し処理と最終行数の取得について紹介します。 記事を読み進めていくことで、マクロVBAを使って同一シート内のデータ処理を自動化するために必要なVBAスキルを習得できます。VBA初学者が添付のレジュメを使って一緒に手を動かしながらVBAコードを記述していくことで、自分のペースでじっくり確実に習得することができます。
ym-pc.com
2023.07.04
Sub データ転記()
With Application.FileDialog(msoFileDialogFilePicker)
Dim r As Long, DLマックス As Long, inp行 As Long
Dim インプット As Worksheet
Dim DLファイル As Workbook
Set インプット = ThisWorkbook.Sheets(1)
inp行 = インプット.Cells(インプット.Rows.Count, 1).End(xlUp).Row + 1 '転記先の最終行の一行下（転記先の行の指定）
If .Show = True Then
Set DLファイル = Workbooks.Open(.SelectedItems(1))'FileDialogオブジェクトで開いたファイルをオブジェクト変数に格納する
DLマックス = DLファイル.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row 'ダウンロードファイル（転記元ファイル）の最終行取得
For r = 2 To DLマックス '転記元ファイルの2行目から最終行のループ
'===================================
'ForNextステートメント内に転記のコードを記述してきます。
'===================================
inp行 = inp行 + 1'転記先の行が1つ下の行になる
Next r
DLファイル.Close False'転記がすべて終われば転記元ファイルを閉じる
End If
End With
End Sub
列挙型Enum（Enumステートメント）
今回のように連続する列にデータを転記していく場合に、列番号を定数にして一括管理するためにEnum使用します。
上図のように、転記元ファイルの「回答番号部分」のみを転記先のExcel規定フォームに順次転記していく場合に、例として以下のようなコードを記述します。
.Cells(inp行,2) = Left(DLファイル.Sheets(1).Cells(r, "B").Value, 1) '問１、性別
.Cells(inp行,3) = Left(DLファイル.Sheets(1).Cells(r, "C"), 1)'問２、部署
'※「inp行」と「ｒ」は変数のため行番号が順次入っていきます。
上記コードの場合、列番号に数字が直接入っているため、転記先コードに列が追加された場合に、列番号を変更する必要がでてきます。
.Cells(inp行,２)
.Cells(inp行,３)
上図のように「問1.性別」列の左に列が追加されたので、下記コードのように列番号をすべて書き換える必要がでてきます。
.Cells(inp行,２)⇒.Cells(inp行,3)
.Cells(inp行,３)⇒.Cells(inp行,4)
.Cells(inp行,3) = Left(DLファイル.Sheets(1).Cells(r, "B").Value, 1) '問１、性別
.Cells(inp行,4) = Left(DLファイル.Sheets(1).Cells(r, "C"), 1)'問２、部署
このようにならないように、Enumを使って列番号を管理します。
.Cells(inp行, CNo回答.問1) = Left(DLファイル.Sheets(1).Cells(r, "B").Value, 1) '問１、性別
.Cells(inp行, CNo回答.問2) = Left(DLファイル.Sheets(1).Cells(r, "C"), 1)
列挙型Enum（Enumステートメント）の特徴
列挙型Enum・・１つずつ増える連番を管理できる定数
列挙型Enum（Enumステートメント）の書き方
Option Explicit
Private Enum CNo回答
回答時間
問1
問2
問2_1
問3
問4
問4_1
End Enum
- 上記のようにEnumの後に任意の名前を指定します。（今回はCNo回答にしています。）そして、End Enumの間にmembername（構成要素）を書いていきます。
- 今回の場合、membername（構成要素）は「回答時間」「問1」「問2」「問2_1」・・です。
- モジュールレベルのみで表示されます。プロシージャの外に記述します。
もっとわかりやすくいえばSub~EndSub外にしか記述できません。
Private Enum ～とした場合は、モジュール内でのみ参照が可能です。
Enumの前に何も記述しなければ規定値としてPublicが入ります。（つまりプロジェクト全体での参照になります。）
membername（構成要素）
Private Enum CNo回答
回答時間 ’0
問1 '1
問2 '2
問2_1 '3
問3 '4
問4 '5
問4_1 '6
End Enum
membername（構成要素）の名前は、意味を持たせることで可読性が向上します。今回の場合は設問の回答の転記なので、設問名をmembername（構成要素）の名前にしています。
また、上記のように要素に番号を指定しなければ、自動的に連番が振られることになります。番号は0から振られます。
１から番号を振りたい場合は下記のように記述します。
Private Enum CNo回答
回答時間 =1
問1
問2
問2_1
問3
問4
問4_1
End Enum
Sub データ転記()
.Cells(inp行, CNo回答.回答時間) = DLファイル.Sheets(1).Cells(r, "A").Value 'タイムスタンプ
.Cells(inp行, CNo回答.問1) = Left(DLファイル.Sheets(1).Cells(r, "B").Value, 1) '問１、性別
.Cells(inp行, CNo回答.問2) = Left(DLファイル.Sheets(1).Cells(r, "C"), 1)'問2、部署
End sub
.Cells(inp行, CNo回答.回答時間)は、.cells(1,1)
.Cells(inp行, CNo回答.問1)は、.cells(1,2)
.Cells(inp行, CNo回答.問2)は、.cells(1,3)
※変数inp行＝1の場合
回答時間 =1以降の要素には、自動的に連番が振られます。問1＝2、問2＝3・・・
番号を振り直したい場合
Private Enum CNo回答
回答時間 '0
問1 '1
問2 '2
問2_1 '3
問3 =9 '9
問4 '10
問4_1 '11
End Enum
途中で番号が指定された場合（問３=9)、以降は連番が振られます。問4＝10、問4_1=11・・・
以上のことから、先述の列の追加や行の追加があった場合に、membername（構成要素）の番号を変更することで、コード上の番号を一括変更することが容易になります。
列挙型Enum（Enumステートメント）のインテリセンス
オブジェクトのプロパティやメソッドのようにEnumの名前の後に「.」（カンマ）を入力することで要素名のインテリセンス（予測変換）が出現するので、入力しやすくなります。
コード
Option Explicit
Private Enum CNo回答
回答時間 = 1
問1
問2
問2_1
問3
問4
問4_1
End Enum
Sub データ転記()
With Application.FileDialog(msoFileDialogFilePicker)
Dim r As Long, DLマックス As Long, inp行 As Long
Dim インプット As Worksheet
Dim DLファイル As Workbook
Dim tmp
Dim x2 As Long
x2 = 0
Set インプット = ThisWorkbook.Sheets(1)
inp行 = インプット.Cells(インプット.Rows.Count, 1).End(xlUp).Row + 1 'インプット先の最終行の一行下
If .Show = True Then
Set DLファイル = Workbooks.Open(.SelectedItems(1))
DLマックス = DLファイル.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row 'ダウンロードファイルの最終行取得
For r = 2 To DLマックス 'ダウンロードファイルの2行目から最終行のループ
With インプット
.Cells(inp行, CNo回答.回答時間) = DLファイル.Sheets(1).Cells(r, "A").Value 'タイムスタンプ
.Cells(inp行, CNo回答.問1) = Left(DLファイル.Sheets(1).Cells(r, "B").Value, 1) '問１、性別
'======問2=====
If Mid(DLファイル.Sheets(1).Cells(r, "C"), 2, 1) = "." Then '左から2文字にピリオドがあれば（＝数字であれば）
.Cells(inp行, CNo回答.問2) = Left(DLファイル.Sheets(1).Cells(r, "C"), 1)
Else
.Cells(inp行, CNo回答.問2) = 5 'その他の番号
.Cells(inp行, CNo回答.問2_1) = DLファイル.Sheets(1).Cells(r, "C").Value
End If
'======問3=====
If DLファイル.Sheets(1).Cells(r, "D").Value <> "" Then '問3が空欄でなければ（条件）
'=====複数回答時の処理=====
If InStr(DLファイル.Sheets(1).Cells(r, "D"), ";") >= 1 Then
tmp = Split(DLファイル.Sheets(1).Cells(r, "D"), ";")
Do While x2 <= UBound(tmp)
tmp(x2) = Left(tmp(x2), 1)
x2 = x2 + 1
Loop
.Cells(inp行, CNo回答.問3) = Join(tmp, ",") '回答欄へ転記
Else '====単数回答時の処理====
.Cells(inp行, CNo回答.問3) = Left(DLファイル.Sheets(1).Cells(r, "D"), 1)
End If
End If
'==========問3、配列変数の添え字の初期化====
If Not IsEmpty(tmp) Then Erase tmp
x2 = 0
'======問4======
If DLファイル.Sheets(1).Cells(r, "E").Value <> "" Then '問4が空欄でなければ（条件）
'=====複数回答時の処理=====
If InStr(DLファイル.Sheets(1).Cells(r, "E"), ";") >= 1 Then
tmp = Split(DLファイル.Sheets(1).Cells(r, "E"), ";")
Do While x2 <= UBound(tmp)
If Mid(tmp(x2), 2, 1) = "." Then '左から2文字にピリオドがあれば（＝数字であれば）
tmp(x2) = Left(tmp(x2), 1)
Else
.Cells(inp行, CNo回答.問4_1) = tmp(x2)
tmp(x2) = 6 'その他の番号
End If
x2 = x2 + 1
Loop
.Cells(inp行, CNo回答.問4) = Join(tmp, ",") '回答欄へ転記
Else '======================単数回答時の処理============================================================
If Mid(DLファイル.Sheets(1).Cells(r, "E"), 2, 1) = "." Then '左から2文字にピリオドがあれば（＝数字であれば）
.Cells(inp行, CNo回答.問4) = Left(DLファイル.Sheets(1).Cells(r, "E"), 1)
Else
.Cells(inp行, CNo回答.問4) = 6 'その他の番号
.Cells(inp行, CNo回答.問4_1) = DLファイル.Sheets(1).Cells(r, "E").Value
End If
End If
End If
'==========問4、配列変数の添え字の初期化====
If Not IsEmpty(tmp) Then Erase tmp
x2 = 0
'==================================================
End With
inp行 = inp行 + 1
Next r
DLファイル.Close False
End If
End With
End Sub
筆者オススメのVBAの本はこちら↓↓
ExcelVBA学習のおすすめの本５選
筆者オススメの「これは秀逸！」「これは１冊持っとくべき」と思えるExcelVBAの本を紹介しています。ExcelVBAの書籍選びで、どれを選んでよいか迷っておられる方に参考にしていただきたいです。
ym-pc.com
2023.07.20
まとめ
列挙型Enum（Enumステートメント）を使用することのメリット
- 列が追加された場合の一括変更が可能
- 可読性の向上
次回は、データ転記における特定の文字や数字を配列に格納してJoin関数でカンマ区切りで転記する方法を紹介します。
VBAデータ転記方法-関数・配列編-
MID関数，LEFT関数、Split関数、Join関数を使った文字の加工、データ転記の方法について紹介しています。
ym-pc.com
2023.10.13
コメント