VBA問題#2「注文書をデータ取込」マクロ①解答

ExcelVBA練習問題シリーズ#2「注文書をデータ取込」マクロ①解答コードです。

取込帳票
取込先データ

もちろんこれが正解という訳ではなく、いろいろなやり方あると思いますが、
ひとつの解答としてご参考ください。

※ 挑戦ポイントには対応していない基本コードになります。

◇ 出題ページはこちら
www.limecode.jp
◇ 解答ページはこちら
VBA問題#2「注文書をデータ取込」マクロ①解答【本ページ】
VBA問題#2「注文書をデータ取込」マクロ②解答
 VBA問題#2「注文書をデータ取込」完成版解答(挑戦ポイント制覇)
　

解答ファイル
ソースコード
解説

解答ファイル

【VBA解答】#2「注文書をデータ取込」マクロ①.xlsm

ソースコード

Option Explicit

' マクロ① 指定パスの注文書を取込
Sub 指定した注文書ファイルを販売データに取り込む()

    ' 取込ファイルの存在・ファイル形式チェック
    Dim path取込ファイル As String: path取込ファイル = WS実行シート.Range("C4")
    Dim 取込ファイル名 As String: 取込ファイル名 = Dir(path取込ファイル)
    
    If 取込ファイル名 = "" Then MsgBox "指定したファイルが存在しません。": Exit Sub
    If Right(取込ファイル名, 5) <> ".xlsx" Then MsgBox "指定ファイルがxlsxファイルではありません。": Exit Sub
    
    
    On Error Resume Next
    
        ' ファイルを開いていなければ開く
        Dim wb取込ファイル As Workbook
        Set wb取込ファイル = Workbooks(取込ファイル名) ' ← 開いていなければエラーでスキップ
        
        If wb取込ファイル Is Nothing Then ' ↑がスキップされていればファイルを開く
            Set wb取込ファイル = Workbooks.Open(path取込ファイル)
        End If
        If wb取込ファイル Is Nothing Then MsgBox "何らかのエラーでファイルが開けませんでした。": Exit Sub
    
        ' シートの存在チェック
        Dim ws注文書 As Worksheet: Set ws注文書 = wb取込ファイル.Worksheets("注文書")
        If ws注文書 Is Nothing Then MsgBox "注文書シートがないファイルです。": Exit Sub
        
    On Error GoTo 0
    
    ' 対象年度が異なれば取込を停止
    Dim 注文書年度 As Long: 注文書年度 = Year(ws注文書.Range("C7"))
    If Month(ws注文書.Range("C7")) <= 3 Then 注文書年度 = 注文書年度 - 1
    If WS販売データ.Range("F2") <> 注文書年度 Then MsgBox "注文書の年度が異なります。": Exit Sub
        
    
    ' メインコードここから
    
    ' 出力第1行(最終行+1)と出力No(最大値+1)を取得
    Dim R_第1出力行 As Long: R_第1出力行 = WS販売データ.UsedRange.Rows.Count + WS販売データ.UsedRange.Row - 1 + 1
    Dim R_出力 As Long: R_出力 = R_第1出力行
    Dim 出力No As Long: 出力No = WorksheetFunction.Max(WS販売データ.Columns(2)) + 1
    
    ' 注文書の表部分をループ
    Dim R_取込 As Long
    For R_取込 = 12 To 21
    
        ' 金額が0でない行を取込
        If ws注文書.Cells(R_取込, 6) <> 0 Then

            WS販売データ.Cells(R_出力, 2) = 出力No ' No
            WS販売データ.Cells(R_出力, 3) = ws注文書.Range("C5") ' 購入者
            WS販売データ.Cells(R_出力, 4) = Month(ws注文書.Range("C7")) ' 月
            WS販売データ.Cells(R_出力, 5) = Day(ws注文書.Range("C7")) ' 日
            WS販売データ.Cells(R_出力, 6) = ws注文書.Cells(R_取込, 3) ' 品物
            WS販売データ.Cells(R_出力, 7) = ws注文書.Cells(R_取込, 4) ' 価格
            WS販売データ.Cells(R_出力, 8) = ws注文書.Cells(R_取込, 5) ' 個数
            WS販売データ.Cells(R_出力, 9) = ws注文書.Cells(R_取込, 6) ' 売上
            WS販売データ.Cells(R_出力, 10) = Date ' 取込日
            
            ' 出力行とNoを更新
            R_出力 = R_出力 + 1
            出力No = 出力No + 1
            
        End If
    
    Next ' 注文書の表部分をループ
            
    WS販売データ.Activate
    WS販売データ.Range(WS販売データ.Rows(R_第1出力行) _
                     , WS販売データ.Rows(R_出力 - 1)).Select
    MsgBox "データの取込を完了しました。"

End Sub

解説

各コードの解説と工夫しているポイントは以下の通りです。

全体を通して

複数のブックとシートを扱うマクロなので、シートの指定はしっかり行います。

Cells、Rangeの親を省略してActiveSheetやActiveWorkbookに実行するのは、
思わぬ事故を呼びますから避けましょう。

今回のような別ブックを指定するマクロでは、wb取込ファイル、ws注文書など、
対象を変数にしっかり入れることでコードが整理されますね。

ちなみに販売データシートは自ブックの中にあるシートのため、
「WS販売データ」というシートオブジェクト名を用いています。

ワークシートには「プログラム上の名前を付ける機能」があり、

シートオブジェクト名の設定

この部分を編集することができます。

何もしないと「Sheet1」とかになってる場所ですね。

ここに画像のように「WS + 実際のシート名」と名付けておくと、
以下のようにシートを指定できるようになります。

Worksheets("領収書").Range("D3") = Worksheets("販売データ").Cells(R_選択行, 2) 'No
' ↓ シートオブジェクトに書き換え
WS領収書.Range("D3") = WS販売データ.Cells(R_選択行, 2) 'No

加えて「WS」を必ず頭につけるルールで全シートを命名しておけば、
Ctrl+Spaceの「コードの入力補完」機能を起動することで、

WS+Ctrl+Spaceの選択肢

こんな風に選択肢から選んで入力することができます。

この時点で既にWorksheets("○○")よりも書きやすそうというのがわかりますが、
さらにWorksheets("○○")と違って

Worksheetからのインテリセンス

この選択肢も表示されるため、以降のコードですらこちらの方が書きやすいです。

他ブックには使えないという弱点はありますが、自ブックのシートを指定する上では、
取り違えも起きづらく、読みやすく、書きやすい最強のシート指定方法です。

まだ使っていなかった方は是非とも採用してみてください。

実行チェック部分

今回のように他ブックのシートを処理するマクロは、
対象シートを取得するまでのエラー対応がなかなか大変です。

対象のファイルがそもそも存在するか？
対象のファイルがExcelファイルか？
対象のファイルを既に開いているか？
対象のファイル内に「注文書」シートがあるか？

あたりをしっかりチェックしておかないといけません。

こういった条件判定を行うときに、

If マクロ実行条件 = False Then
    警告などの処理
Else
    メインコードここから


End If

という書き方をせず、
　

If マクロ実行条件 = False Then
    警告などの処理
    Exit Sub
End If

メインコードここから

という書き方にすると、メインコードのインデントをひとつ減らすことができますし、
判定が連続してもお互いに干渉することなくコードを書くことができます。

小さなテクニックですが覚えておいてください。

www.limecode.jp

また、この判定コードの書き方のポイントとして、
If文はElseがなければ複数行でもまとめて1行に書くことができます。

If Selection.Rows.Count >= 2 Then
    MsgBox "1行だけを選択して実行して下さい。"
    Exit Sub
End If

' ⇩書き替え

If Selection.Rows.Count >= 2 Then MsgBox "1行だけを選択して実行して下さい。": Exit Sub

　
この方法は1長1短あり、その行自体はちょっと読みづらなってしまいますが、
コード全体としては見渡しやすくなった分読みやすくなっています。

「:」を使った複数コードの1行記述(マルチステートメント)は、

使った行を少し読みづらくする
その分マクロ全体が読みやすくなる

こんな特徴がありますので、場面によって使ってみてください。

また、今回のような「存在するかわからないものを取得する処理」は、
On Error Resume Nextによる判定がとても便利です。

Set Workbooks(○○) としてみて、エラーならブックを開いていない
Workbooks.Open(○○)としてみて、エラーなら開くのに失敗している
Worksheets(○○)としてみて、エラーならシートが存在しない

　
こういった処理をまとめてやってしまうには、
今回のようにOn Error Resume NextをIfブロックのようにまとめてみましょう。

On Error Resume Next ' ← ここから

    ' ファイルを開いていなければ開く
    Dim wb取込ファイル As Workbook
    Set wb取込ファイル = Workbooks(取込ファイル名) ' ← 開いていなければエラーでスキップ
    
    If wb取込ファイル Is Nothing Then ' ↑がスキップされていればファイルを開く
        Set wb取込ファイル = Workbooks.Open(path取込ファイル)
    End If
    If wb取込ファイル Is Nothing Then MsgBox "何らかのエラーでファイルが開けませんでした。": Exit Sub

    ' シートの存在チェック
    Dim ws注文書 As Worksheet: Set ws注文書 = wb取込ファイル.Worksheets("注文書")
    If ws注文書 Is Nothing Then MsgBox "注文書シートがないファイルです。": Exit Sub
    
On Error GoTo 0 ' ここまでがエラーを活用した取得処理

　
On Error Resume Nextは便利なのですが、
そのままでは危険なので最後にOn Error GoTo 0が必要になります。

その間をIf文やFor文でやるようなインデントをしておくことで、
「エラースキップを活用した他ブック取得コード」の範囲を明示できます。

コードを短くする効果もあるので、先ほどのIf～Exit1行記法と組み合わせると、
冒頭の実行チェックをかなり短く済ませることができますね。

本題のメインコード開始までを圧縮できると、マクロ全体がスッキリします。

冒頭チェックにはこの二つの方法をご活用ください。

シートの取込部分

今回の本題であるデータ取込のメインコードがこちらでした。

' 出力第1行(最終行+1)と出力No(最大値+1)を取得
Dim R_第1出力行 As Long: R_第1出力行 = WS販売データ.UsedRange.Rows.Count + WS販売データ.UsedRange.Row - 1 + 1
Dim R_出力 As Long: R_出力 = R_第1出力行
Dim 出力No As Long: 出力No = WorksheetFunction.Max(WS販売データ.Columns(2)) + 1

' 注文書の表部分をループ
Dim R_取込 As Long
For R_取込 = 12 To 21

    ' 金額が0でない行を取込
    If ws注文書.Cells(R_取込, 6) <> 0 Then

        WS販売データ.Cells(R_出力, 2) = 出力No ' No
        WS販売データ.Cells(R_出力, 3) = ws注文書.Range("C5") ' 購入者
        WS販売データ.Cells(R_出力, 4) = Month(ws注文書.Range("C7")) ' 月
        WS販売データ.Cells(R_出力, 5) = Day(ws注文書.Range("C7")) ' 日
        WS販売データ.Cells(R_出力, 6) = ws注文書.Cells(R_取込, 3) ' 品物
        WS販売データ.Cells(R_出力, 7) = ws注文書.Cells(R_取込, 4) ' 価格
        WS販売データ.Cells(R_出力, 8) = ws注文書.Cells(R_取込, 5) ' 個数
        WS販売データ.Cells(R_出力, 9) = ws注文書.Cells(R_取込, 6) ' 売上
        WS販売データ.Cells(R_出力, 10) = Date ' 取込日
        
        ' 出力行とNoを更新
        R_出力 = R_出力 + 1
        出力No = 出力No + 1
        
    End If

Next ' 注文書の表部分をループ

　
前述の通り両シートをシートオブジェクト名と変数にしっかり入れているので、
スッキリ読みやすいコードになっていると思います。

またもう一つ地味に重要なのが、「行番号の変数名をR_○○」としている」点です。

こういったループカウンタに「i」や「j」を用いるコードをたまに見かけますが、
わざわざ似ているアルファベットコンビを用いても混乱のもとなのでやめましょう笑

そもそもいろいろなループカウンタに「i」を使っていると、
シートのFor文とセルのFor文を後から合体できない問題も発生します。

カウンタ変数を「何のカウンタかわかるように命名」しておけば、
コードも読みやすく、取り違えも起きづらくなります。

地味ですが大事なポイントなので押さえておいてください。
www.limecode.jp

取込データを選択してから完了通知

今回のように「元データが既にあるところにデータを追加する処理」をする際は、
追加したデータ範囲を明示してあげると親切です。

WS販売データ.Activate
WS販売データ.Range(WS販売データ.Rows(R_第1出力行) _
                 , WS販売データ.Rows(R_出力 - 1)).Select
MsgBox "データの取込を完了しました。"

　
どれが取り込んだデータなのかわかるとユーザーはありがたいですし、
マクロをテストするときにも便利なので自分のためにもなります。

「完了時にSelectするだけ」とコードはとても簡単ですので、
最後のひと手間を加えて親切設計なマクロにしてあげてください。

以上でマクロ①の解説を終わります。

基本コードの詰め合わせでしたが、
読みやすく書こうとすると、工夫できるポイントがたくさんありましたね。

参考にしながら、マクロ②の方にも取り組んでみてください。

和風スパゲティのレシピ

日本語でコーディングするExcelVBA