エクセルのマクロの登録について

質問

エクセルのマクロ登録についてご質問です。

エクセルでマクロを登録したいのですが、
D7～D49まで自動で数式が反映するようにしてあります。
マクロのボタンを作成し、そのボタンを押すとコピーを選択した状態になるようにしてあります。

これが、すぐよこのE列～AH列まで日付が並んでおり、D7～D49に反映させたデータを
対応する日付の下に毎日値貼り付けをしている常態です。

　　　　D　　　　　　E　　　　　F　　　　 G
　　自動反映　　　9/1　　　9/2　　　9/3
７　　

～

４９

ボタンひとつでコピーした状態ではなく、その対応した日付の下に値貼り付けすることはできますでしょうか。

これがシート１、シート２、シート３、シート４まで
あるのですが、ボタンひとつで登録するようにできますでしょうか。

どなたかご回答よろしくお願い致します。

回答No.4

cj_mover · ベストアンサー

＃２、３、ｃｊです。

どうも、こちらの反応が遅かったみたいですみません。
改めてレスします。（＃２、３は忘れて結構です）
＃１補足欄の内容を確認させてもらいましたので、今回に反映させました。

> これがシート１、シート２、シート３、シート４まで
> あるのですが、ボタンひとつで登録するようにできますでしょうか。

ひとつのボタン、っていうと、
・Userformを応用的に使うような場合
（きちんとしようとすると結構手数が多いです）
・クイックアクセスツールバーに登録する場合
（マクロを必要としないブックで、表示されないようにする工夫など、管理が難しいです。）

・一番現実的なのは、各シート毎にボタンひとつずつ設置して、ひとつのマクロを登録する方法です。
（これは説明する必要ないでしょう）

ここでは、対象ブックが開いている間だけ有効になる「ショートカットキー」への
登録（解除）方法を紹介しておきます。

' ★
Macro名は適宜書き換えてください。（２カ所）
' ★★
マクロを有効にするシート名を正しい名前で指定してください。
質問文通りの場合は
　　Case "シート１", "シート２", "シート３", "シート４"　
のようになります。
シート名が全角数字の場合なら
　　Case "１", "２", "３", "４"　
のようになります。

以下のマクロを対象ブックの標準モジュールに貼り付けて、
まず、Private Sub Auto_Open()　を実行します。
ショートカットキーが設定されますので、
Ctrl+Shift+C、というキーボード操作で、ご希望の処理ができるようになります。
動作確認の上、上書き保存をすれば、次回から自動で、
対象ブックを開いている間だけ機能させることができます。

また、Sub Macro名()で示したマクロは、
追加された詳細条件を反映させた形で書いてありますので、
仮にショートカットキー以外の方法を選んでも使えます。

何かあれば補足してみてください。

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

Sub Macro名()' ★
' Keyboard Shortcut: Ctrl+Shift+C
　　If ActiveWorkbook.Name <> ThisWorkbook.Name Then Exit Sub
　　If TypeName(Selection) <> "Range" Then Exit Sub

　　Select Case ActiveSheet.Name
　　Case "Sheet1", "Sheet2", "Sheet3", "Sheet4"　　' ★★ マクロを有効にするシート名を列挙
　　Case Else: Exit Sub
　　End Select

　　If Val(Range("B4").Text) <> Year(Date) Or Val(Range("B5").Text) <> Month(Date) Then _
　　　　MsgBox "年度または月度が違います": Exit Sub

　　With Range("D7:D49")
　　　　.Offset(, Day(Date)).Value = .Value
　　End With
End Sub

Private Sub Auto_Open()
　　Application.OnKey Key:="+^c", Procedure:="Macro名"' ★
End Sub

Private Sub Auto_Close()
　　Application.OnKey Key:="+^c"
End Sub
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

回答No.3

cj_mover

＃２、ｃｊです。
たぶん、お求めの応えになっていなかったようです。

数式の戻り値を値貼付けしたい、ということですよね。
失礼しました。やり直しです。

日付が６行めにある場合。
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
　　Dim dtTarget As Date
　　Dim r As Range

　　dtTarget = Date
　　For Each r In Range("E6:AI6")
　　　　If CDate(r.Text) = dtTarget Then Exit For
　　Next
　　If Not r Is Nothing Then
　　　　r.Offset(1).Resize(43).Value = Range("D7:D49").Value
　　End If
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

日付が１行めにある場合。
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
　　Dim dtTarget As Date
　　Dim r As Range

　　dtTarget = Date
　　For Each r In Range("E1:AI1")
　　　　If CDate(r.Text) = dtTarget Then Exit For
　　Next
　　If Not r Is Nothing Then
　　　　r.Offset(6).Resize(43).Value = Range("D7:D49").Value
　　End If
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

回答No.2

cj_mover

こんにちは。お邪魔します。
お急ぎのようなので、レスします。

実行時の（今日の）日付、ということでしたら、以下のように。

日付が６行めにある場合。
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
　　Dim dtTarget As Date
　　Dim r As Range

　　dtTarget = Date
　　For Each r In Range("E6:AI6")
　　　　If CDate(r.Text) = dtTarget Then Exit For
　　Next
　　If Not r Is Nothing Then
　　　　Range("D7:D49").Copy Destination:=r.Offset(1)
　　End If
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

日付が１行めにある場合。
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
　　Dim dtTarget As Date
　　Dim r As Range

　　dtTarget = Date
　　For Each r In Range("E1:AI1")
　　　　If CDate(r.Text) = dtTarget Then Exit For
　　Next
　　If Not r Is Nothing Then
　　　　Range("D7:D49").Copy Destination:=r.Offset(6)
　　End If
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

コピーからペーストまで一発で処理します。
現在お使いのマクロの中身、
Subで始まる行とEnd Subで終る行の間を差し替えて使うように書いてあります。

また、日付に関しては、
日付型でも文字列型でも、定数でも数式の戻り値でも、
つまり少々の間違いがあっても見た目さえ日付になっていれば、
機能するように書いています。

ただ、問題の日付が何行めにあるのか示されていませんので
「日付が６行めにある場合。」
「日付が１行めにある場合。」
２例挙げました。相違点は２カ所。
他の行だったとしても、ふたつを見比べ、要領を汲み取って、応用してください。

回答No.1

MSZ006

＞その対応した日付の下に値貼り付けする

「対応した日付」というのはどこで判断するのでしょうか？

補足

回答ありがとうございます。
毎日データを入力するので、たとえば本日であれば、9/9の箇所に入力をしています。
B4に年、B5に月、E4～AI4に日付が入力されております。

よろしくお願い致します。