転記用マクロをサクッと書いてみた(Excel) - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

転記用マクロをサクッと書いてみた

Twitterで話題になっていたのでちょっと乗っかってみた。

転記処理は、基本的に各転記元のブックの方で、集計（積み上げ）対象のデータ（笑）だけを別シートに転記しておいて、集計（積み上げ）時には、そのシートのデータ（笑）をまるごと集計（積み上げ）用シートに積み上げていくことしかやったことがなかったので、ちょっと腕試しに……。

お題

転記元のブックは複数ある（たぶん、ファイル名もでたらめ。）。
転記元ブックのシートのデータ（笑）を全て転記するわけではなく、特定の条件に当てはまっている行のデータ（笑）のみ転記する。

だいたいこういう条件だと思った。

実験の準備

次のように、テスト用のデータ（笑）を準備した。

転記先ブックと転記元ブック

f:id:akashi_keirin:20190103175729j:plain

画像のように、フォルダ内に、転記先ブック一つと転記元ブック複数を用意した。

転記先ブック

f:id:akashi_keirin:20190103175737j:plain

転記先ブックには、このように項目のラベルだけを作った。

ファイル名が「★転記先ブック.xlsm」となっていることからお分かりのように、マクロはこのブックに書く。

転記元ブック

転記元ブックは、次のように複数準備した。

転記元01.xlsx

f:id:akashi_keirin:20190103175747j:plain

転記元02.xlsx

f:id:akashi_keirin:20190103175801j:plain

転記元03.xlsx

f:id:akashi_keirin:20190103175924j:plain

転記元04.xlsx

f:id:akashi_keirin:20190103180101j:plain

このように、実に詳細なデータ（笑）の入った四つのブックを用意した。あーしんど。

コーディング

とりあえず、再利用性や保守（保守は英語でメンテナンス）性は無視。心にうつりゆくよしなしコードを、そこはかとなく書きつけたものが次のコード。

リスト１　標準モジュール

Public Sub transferData()
  '転記先シートを変数にぶち込む'
  Dim mainSh As Worksheet
  Set mainSh = Sheet1
  '現在のフォルダパスを変数にぶち込む'
  Dim folderPath As String
  folderPath = ThisWorkbook.Path & "\"      '"
  '処理済みファイル用フォルダの準備'
  Dim saveFolder As String
  saveFolder = folderPath & "処理済み\"     '"
  '「処理済み」フォルダがなかったら作る'
  If Dir(saveFolder) = "" Then Call MkDir(saveFolder)
  '一つ目の転記元ブックのファイル名を取得'
  Dim targetFileName As String
  targetFileName = Dir(folderPath & "*.xlsx", vbNormal)
  '該当ファイルにヒットしなければ煽って終了ｗ'
  If targetFileName = "" Then _
    Call XlsCommon.makeUserSick("ファイルがないんじゃぼけー！"): _
    Exit Sub
  '転記先シートの転記対象行番号用変数の準備＆初期化'
  Dim n As Long 
  n = 2
  Do While targetFileName <> ""
    '転記元シートを取得して変数にぶち込む'
    Dim targetSh As Worksheet
    Set targetSh = Workbooks.Open(folderPath & targetFileName).Worksheets(1)
    '転記元シートのデータ（笑）最終行を取得'
    Dim maxRow As Long
    maxRow = targetSh.Cells(Rows.Count, 1).End(xlUp).Row
    '転記元シートをスキャン'
    Dim i As Long
    For i = 2 To maxRow
      With mainSh
        '条件に当てはまったら転記＆行番号用変数インクリメント'
        If targetSh.Cells(i, 7).Value = "先捲" Or _
           targetSh.Cells(i, 7).Value = "捲先" Then
          .Range(.Cells(n, 1), .Cells(n, 8)).Value = _
            targetSh.Range(targetSh.Cells(i, 1), targetSh.Cells(i, 8)).Value
          n = n + 1
        End If
      End With
    Next
    '転記元ブックを保存せずに閉じる'
    Call targetSh.Parent.Close(SaveChanges:=False)
    '「処理済み」フォルダへ移動'
    Name folderPath & targetFileName As _
         saveFolder & targetFileName
    '次の転記元ブックのファイル名を取得'
    targetFileName = Dir()
  Loop
  'データ（笑）の範囲に格子罫線を施す'
  mainSh.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
End Sub

処理の手順は全てコード中にコメントで記した。転記元の表のデータ（笑）の中から、「戦法」が「先捲」か「捲先」の行のデータ（笑）だけを転記先ブックに積み上げていくマクロ。我ながらReadableなコードだとｑあｓうぇｄｒｆｔｇｙふじこｌｐ……あっ、物を投げないでくださいよ！

そうそう、コード中のXlsCommon.makeUserSickメソッドについては、

akashi-keirin.hatenablog.com

コチラをどうぞ。