エクセル 特定のセルをダブルクリックすると別シートの特定のセルから数値を抽出して表示するマクロ

以前、Sheet2!D列をダブルクリックすると、Sheet1から抽出した数値をSheet2!C列に表示するようにしていたのですが、ダブルクリックするセルを変更したらわけがわからなくなってしまいました。
以下はそのときのソースです。
どのようにしたら正常に動作しますか？

Sheet1のB列には番号、D列以降に日付が入っています。
Sheet2のC列にはSheet1!B列と同じ番号が順不同で入っています。

やりたいことは、Sheet2!I列（空白セルならどこでも良いが便宜上I列としたいです）をダブルクリックしたら、Sheet1の今日の日付の同じ番号の数量をSheet2!H列に表示したいです。
例えば今日が7/1として、Sheet2!I12をクリックしたら320がSheet2!H12に表示されるようにしたいです。
おねがいします。


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim c As Range, r As Range
If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
If Target.Row > 2 Then
Cancel = True

With Worksheets("Sheet1")
Set c = .Rows(151).Find(what:=DateValue(Date), LookIn:=xlFormulas, lookat:=xlWhole)
If Not c Is Nothing Then '//←念のため//
Set r = .Range("B:B").Find(what:=Target.Offset(, -2), LookIn:=xlValues, lookat:=xlWhole)
Target.Offset(, -1) = .Cells(r.Row + 4, c.Column)
End If
End With
End If
End Sub

No.1 ベストアンサー 回答者： tom04 回答日時： 2019/06/30 20:13

こんばんは！

お示しの画像通りの配置だとします。
Sheet2のシートモジュールです。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　Dim c As Range, r As Range
　Dim wS As Worksheet
　　Set wS = Worksheets("Sheet1")
　　If Intersect(Target, Range("I:I")) Is Nothing Then Exit Sub
　　　With Target
　　　　If .Row > 2 Then
　　　　　Cancel = True
　　　　　　Set c = wS.Rows(151).Find(what:=DateValue(Date), LookIn:=xlFormulas, lookat:=xlWhole)
　　　　　　　If Not c Is Nothing Then
　　　　　　　　Set r = wS.Range("B:B").Find(what:=Cells(.Row, "C"), LookIn:=xlValues, lookat:=xlWhole)
　　　　　　　　　If Not r Is Nothing Then
　　　　　　　　　　.Offset(, -1) = wS.Cells(r.Row + 4, c.Column)
　　　　　　　　　Else
　　　　　　　　　　MsgBox "該当番号なし"
　　　　　　　　　End If
　　　　　　　Else
　　　　　　　　MsgBox "該当日付なし"
　　　　　　　End If
　　　　End If
　　　End With
End Sub

こんな感じで大丈夫だと思います。m(_ _)m

この回答へのお礼

私の思っていた動きができました。
ありがとうございました！

お礼日時：2019/07/01 00:22

No.2 回答者： WindFaller 回答日時： 2019/06/30 21:14

私の方では、画像をみても要領が、今ひとつわからないのですが、

>Sheet2!I12をクリックしたら320がSheet2!H12に表示されるようにしたいです。
>Sheet2!I列（空白セルならどこでも良いが便宜上I列としたいです）

I12とかは任意の行だけでなく、列も任意の場所ということではないでしょうか。
だから、D列、E列にもクリックすることはありうることではないかと思いました。

No.1さんのほうから、コードは既に出ていますので、こちらからあえて、今の時点では、コードをアップの必要はないかと思います。読み違いしているのなら、スルーしてください。