データ転記マクロ～その２

前回の転記用マクロを書き換えてみる。

元のコードを下に再掲。ただし、余計なコメントは除去。コメント入りがご所望ならコチラをどうぞ。

Sub sendDataVer1()
  Dim folderPath As String
  folderPath = ThisWorkbook.Path
  Dim objSheet As Worksheet
  Set objSheet = ActiveSheet
  Dim objFileName As String
  objFileName = objSheet.Parent.Name
  With ThisWorkbook.Worksheets("集約")
    Dim tgtRow As Integer
    tgtRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Range("A" & tgtRow).Value = objSheet.Range("B3").Value 'No.      '……(*)
    .Range("B" & tgtRow).Value = objSheet.Range("B7").Value '級
    .Range("C" & tgtRow).Value = objSheet.Range("C7").Value '班
    .Range("D" & tgtRow).Value = objSheet.Range("F3").Value '氏名
    .Range("E" & tgtRow).Value = objSheet.Range("F5").Value '期別
    .Range("F" & tgtRow).Value = objSheet.Range("B5").Value '登録
    .Range("G" & tgtRow).Value = objSheet.Range("F7").Value '戦法
  End With
  objSheet.Parent.Close False
  Name folderPath & "\" & objFileName As _
       folderPath & "\処理済\" & objFileName
End Sub

(*)の部分がいかにもブサイクなので書き換える。

その前に、セルに名前を付ける。

こんな風に名前の中に連番をかましておくと、たとえば

Range("data" & Format(i, "0#"))

って書いたら、変数「i」のインクリメントで名前を付けたセルを順番に取得できる。

これを生かして、上掲コードの(*)の部分を

Dim i As Integer    '……(*)'
For i = 1 To 7
  .Cells(tgtRow, i).Value = Range("data" & Format(i, "0#")).Value    '……(1)
Next

と書き換えてやれば、７つのデータの転記を３行で書くことができる（変数宣言も入れたら４行だけど）。ただ、難点はコードの可読性が下がることだな。一応コードの説明をしておこう。

• (1)をForループで７回回すことになる。
• ループ１回目は、「i」が「1」なので、１列目（＝Ａ列）に「Data01」という名前のセルの値を書き込む。
• ループ２回目は、「i」が「2」なので、２列目（＝Ｂ列）に「Data02」という名前のセルの値を書き込む。
• 以下、「i」が「7」になるまで繰り返す。

一応コードを全部載っけとく。

Sub sendDataVer2()
  '作業フォルダパスを変数に格納
  Dim folderPath As String
  folderPath = ThisWorkbook.Path
  'アクティブシートを変数にセット
  Dim objSheet As Worksheet
  Set objSheet = ActiveSheet
  '個票ブックのファイル名を変数にセット
  Dim objFileName As String
  objFileName = objSheet.Parent.Name
  'データの転記
  With ThisWorkbook.Worksheets("集約")
    Dim tgtRow As Integer
    tgtRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    Dim i As Integer                                                       '……(*)'
    For i = 1 To 7
      .Cells(tgtRow, i).Value = Range("data" & Format(i, "0#")).Value  '……(1)
    Next
  End With
  '個票ファイルを閉じてフォルダ移動
  objSheet.Parent.Close False
  Name folderPath & "\" & objFileName As _
       folderPath & "\処理済\" & objFileName
End Sub

実行すると、

ほれ、この通り。

ただ、上にも書いたけど、コードの可読性が下がっているというのは問題だと思う。初心者がちょっと腕前が上がってくるとこんなコードを書きがちなんじゃないかな。「オレならもっと短く書けるぜ！」みたいな感じで。んで、いろいろひねくり回して短いコードを書いた挙げ句、後で自分で読んで意味が分からず解読に時間がかかるとかｗ

文章なんかでもそうだけれど、短さと読みやすさは必ずしも比例しない。ブサイクかも知れないけど先に挙げた「sendDataVer1」の方が良いのかも知れませんね。

@akashi_keirin on Twitter