【エクセルVBA】別シートからカレンダーに行事を転記する方法

2019年8月5日
2019年8月31日
カレンダーアプリ
VBA, データ転記, ｶﾚﾝﾀﾞｰ

カレンダーアプリ

みなさん、こんにちはケンケンです。

エクセルVBAを使ってカレンダー作りをしています。

今回は、別シートで管理しているイベント一覧から行事内容を転記する方法をご紹介します。

データ転記は実務ではかかせない作業なので、これを機にマスターしちゃいましょう。

前回の復習はこちらからどうぞ。

1 別シートからカレンダーに行事を転記する
2 まとめ

別シートからカレンダーに行事を転記する

カレンダーを作るコードは以前書いたものを使います。

Sub hiduke_rensyu10()
    Dim sday '最初の日という意味
    Dim ntuki '次の月を格納
    Dim stuki '翌月の最初の日を格納
    Dim lday '最後の日という意味
    
    ntuki = Range("D2").Value + 1
    If ntuki = 13 Then
        ntuki = 1
        sday = CDate(Range("C2") & "/" & Range("D2") & "/" & "1")
        stuki = CDate(Range("C2") + 1 & "/" & ntuki & "/" & "1")
        lday = stuki - 1
        
    Else
        sday = CDate(Range("C2") & "/" & Range("D2") & "/" & "1")
        stuki = CDate(Range("C2") & "/" & ntuki & "/" & "1")
        lday = stuki - 1
        
    End If
    
    
    Dim cnt '書き出し先のカウント変数
    cnt = 2
    Do While sday <= lday
        Range("A" & cnt).Value = sday
        sday = DateAdd("d", 1, sday)
        cnt = cnt + 1
    Loop
End Sub

下図のように年と月を指定してコードを実行し、2020年７月を表示させておきましょう。

シートを初期化するコードを書こう

さて、これから転記するためのコードを書いていくのですが、その前にシートを初期化するコードを書きます。

初期化とはデータをまっさらな状態に戻すことを言い、今回は、A列とB列の文字列を消します。

hiduke_rensyu10プロシージャに以下のように追加します。

    stuki = CDate(Range("C2") & "/" & ntuki & "/" & "1")
        lday = stuki - 1
        
    End If
 ------------------この下追加-----------------------   
    Range("A:B").ClearContents '初期化①
    Range("A1").Value = "日付" '②
    Range("B1").Value = "主な行事" '②
 -----------------この上追加-----------------------     
    Dim cnt '書き出し先のカウント変数
    cnt = 2
    Do While sday <= lday

コードの解説をします。

①セルの値を削除したい場合は、ClearContentsメソッドを使います。

Range(“A:B”).ClearContentsのようにRangeオブジェクトの後にメソッドを書きます。

Range(“A:B”)はA列とB列のことですから、A列とB列の値を削除する、という意味ですね。

ちなみに、似たメソッドでClearメソッドがありますが、これは、値だけでなく書式などすべてが初期化（削除）されます。

今回は、値のみを消したいのでClearContentsを使いました。

②A列とB列に見出しをつけます。

A１セルに日付、B１セルに主な行事として表示されています。

当然①の範囲指定でA1セルとB1セルの値を消去しなければ、②のコードは不要になります。

お好みで使ってください。

初期化するコードは重要なので、意識的に使えるようにしてください。

これを忘れるとデータがどんどん上書きされてしまい、何が正しいデータか分からなくなってしまいます。

シート名は明確に分けておこう

続きまして、転記する方法をご紹介します。

これも前回書いたコードを使って応用していきます。

Sub kensaku_offset1()
    Dim cnt
    Dim kensakucnt
    For kensakucnt = 2 To 4
        For cnt = 2 To 6
            If Range("A" & cnt).Value = Range("F" & kensakucnt).Value Then
                Range("G" & kensakucnt).Value = Range("A" & cnt).Offset(0, 1).Value
                Range("H" & kensakucnt).Value = Range("A" & cnt).Offset(0, 2).Value
            End If
        Next
    Next
End Sub

こちらのコードを修正していくのですが、このコードは検索元と転記先を同一シートで行っていました。

今回は、シート間でデータのやり取りをしたいので、検索元と転記先のシートを明確に分ける必要があります。

具体的には、シート名を以下のようにしています。

転記先のシート名を「カレンダー練習」
検索元のシート名を「イベント一覧」

プロシージャを修正してみよう

２つのシートが用意出来たら、

まず結論ありき、ということで修正後のプロシージャをお見せします。

Sub kensaku_offset1()
    Dim cnt
    Dim kensakucnt
    Dim eSheet As Worksheet '検索元イベント一覧シート
    Dim cSheet As Worksheet '転記先カレンダーシート
    Dim motoLrow
    Dim sakiLrow
    
    Set eSheet = Sheets("イベント一覧") '①
    Set cSheet = Sheets("カレンダー練習") '②
    
    motoLrow = eSheet.Range("A" & Rows.Count).End(xlUp).Row 'イベント一覧シートの最終行'③
    sakiLrow = cSheet.Range("A" & Rows.Count).End(xlUp).Row 'カレンダー練習シートの最終行'④
    
    For kensakucnt = 2 To sakiLrow '⑤
        For cnt = 2 To motoLrow '⑥
            If eSheet.Range("A" & cnt).Value = cSheet.Range("A" & kensakucnt).Value Then '⑦
                cSheet.Range("B" & kensakucnt).Value = eSheet.Range("A" & cnt).Offset(0, 1).Value'⑦
            End If
        Next
    Next
End Sub

だいぶ複雑になったと思われたかもしれませんが、核になる部分は変わっていないので、前回の仕組みを理解できていれば、修正後のコードも理解できるはずです。

それでは修正点をひとつずつ解説していきます。

①②まず、転記元のシートと転記先のシートを明確に区別するために、シートそのものを変数に格納します。

シートはオブジェクトです。オブジェクトを格納するための変数はオブジェクト型(as worksheet)として宣言する必要があります。

宣言した変数にSetを付けてシート名を指定することで、その変数名をsheetオブジェクトとして使えるようになります。

オブジェクト型の変数を復習したい方はこちらをどうぞ。

今回は、「カレンダー練習」と「イベント一覧」シートをそれぞれの変数に格納しています。

③④「カレンダー練習」と「イベント一覧」シートそれぞれの最終行を取得しています。

カレンダーの日付（A列）もイベント一覧も常に最終行が一定ではないので、変数を使って変動に対応できるようにします。

⑤⑥最終行を取得した２つの変数を繰り返し構文の最終値として設定します。

繰り返し構文が２つあって混乱してしまう方は、前回の記事を復習しましょう。ひとつずつ手順を紹介しています。

⑦検索元と転記先の２つのシートを各Rangeオブジェクトの前に指定し、対象を明確にします。