エクセル 日報売上を月報売上に日付をキーにして反映

質問

エクセル 日報売上を月報に展開するマクロで困っております。

準備するシート
(1)日報入力シート
(2)月報売上シート

日報入力シートに作ったボタンを押すとB3の日付（今日）と月報売上シートA列の2～31に用意された日付（１ヶ月分）を参照する

一致した場所（B列～D列）に 入力シート B7:D7のデータを貼り付ける作業を考えております。

以下は過去の事例を参考にさせて頂きました。日付が横軸ですが、目的は縦軸です。

日報入力は1回のみですので、重複はなく1行ずらす処理は必要ありません。

ご教示頂けば助かります。
よろしくお願い致します。

Sub ボタン1_Click()
Dim FRng As Range
Dim Rw As Long
With Sheets("月報売上シート")
If Range("B3").Value = "" Then
MsgBox "入力日を記入してください。", vbExclamation
Exit Sub
End If

Set FRng = .Rows(1).Find(Range("B3").Value, lookat:=xlWhole)
If Not FRng Is Nothing Then
Rw = .Cells(Rows.Count, FRng.Column).End(xlUp).Row
If Rw < 3 Then Rw = 3 Else Rw = Rw + 1
.Cells(Rw, FRng.Column).Resize(, 3).Value = Range("B7:D7").Value
Else
MsgBox "転記先日付が 見つかりません。", vbCritical
Exit Sub
End If
End With
Set FRng = Nothing
MsgBox "転記しました。", vbInformation, "完了"
End Sub

回答No.2

dogs_cats

方法は色々あると思いますが、日付を検索する必要性はあるのでしょうか？
月報のA2が１日と決まっているのですから、日報の日付の日付だけ１日に変換した変数が一致した場合はデータを入力させる。
データを入力させる行は売上日に日付+１行目となります。
月報の日付はマクロで作成する事とすれば日付が間違える事はありませんよね。
日報のデータは７行目で無く６行目ですよね。

下記は修正案の一例です。
Sub ボタン1_Click()
Dim FRng As Range
Dim Rw As Long
Dim mydate As Date
Dim ws As Worksheet
Dim myday As Integer

Set ws = Sheets("月報売上シート")

With Sheets("日報入力シート")
If .Range("B3").Value = "" Then
MsgBox "入力日を記入してください。", vbExclamation
Exit Sub
End If

mydate = DateSerial(Year(.Range("B3")), Month(.Range("B3")), 1)
myday = Day(.Range("B3"))

If mydate = ws.Range("A2") Then
ws.Cells(myday + 1, 2).Resize(, 3).Value = .Range("B6:D6").Value
Else

MsgBox "転記先日付が 見つかりません。", vbCritical
Exit Sub

End If

End With
MsgBox "転記しました。", vbInformation, "完了"

End Sub

補足

dogs_catsさん、
kagakusuki さん
早速にご返答ありがとうございました。

月報売上シートのカレンダーはマクロで作成するのではなく、

関数を利用し、任意のセルに年と月を入力すると、
A列に日付（標準の数値）
B列に曜日（関数式）

が入る万年カレンダーを作成しようと考えております。

よってA列の数値を参照させたいと思います。

その場合の変更はどのようになりますでしょうか？

お手数おかけしますがよろしくお願い致します。

回答No.1

kagakusuki

日付データはFindメソッドとの相性が悪いため、日付を検索する事は出来ないと思います。
　ですから以下の様に、日付けのシリアル値を整数値に変換した値をMach関数で検索する様なマクロにされては如何でしょうか？

Sub QNo9083059_エクセル_日報売上を月報売上に日付をキーにして反映()

Const OutputSheetName = "月報売上シート"
Const DateCell = "B3"
Dim OutputSheet As Worksheet, temp

If IsError(Evaluate("ROW('" & OutputSheetName & "'!A1)")) Then
MsgBox "データの転記先のシートとして設定されている" _
& vbCrLf & vbCrLf & OutputSheetName & vbCrLf & vbCrLf & _
"というシート名のシートが見つかりません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "存在しないシート"
Exit Sub
End If
Set OutputSheet = Sheets(OutputSheetName)
temp = Range(DateCell).Value
If temp < 1 Or Not IsDate(temp) Then
MsgBox DateCell & "セルに日付が入力されていません。" _
& vbCrLf & "マクロの実行を一旦中止しますので、" & DateCell & _
"セルに日付を入力してから、再度マクロの実行ボタンをクリックし直して下さい。" _
, vbExclamation, "日付未指定"
Exit Sub
End If
If WorksheetFunction.CountIf(OutputSheet.Columns("A:A"), temp) = 0 Then
MsgBox "指定された日付" & vbCrLf & vbCrLf & temp & vbCrLf & vbCrLf _
& "に該当する行が見つかりません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "該当する日付なし"
Exit Sub
End If
OutputSheet.Range("B" & WorksheetFunction.Match(CLng(temp), _
OutputSheet.Range("A:A"), 0)).Resize(1, 3).Value = Range("B6:D6").Value
MsgBox "転記しました。", vbInformation, "完了"

End Sub