Worksheet_Change(ByVal Target As Range)のやり方

いつもお世話になっております。
以前、頂いました、コードの
質問があります。

Case "E"
のところを
Range("D4") range("D5")どちらもIsdateだったら
という条件をつけるにはどうしたらいいの
おしえてくれませんでしょうか
よろしくお願いいたします。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim st As String
Dim cnt As Long

With Target
st = .Address(False, False)
st = Left(.Address(0, 0), IIf(.Address(0, 0) Like "[A-Z][A-Z]*", 2, 1))

End With

Select Case st
Case "E"
If IsDate(.Value) Then
ActiveSheet.Shapes.AddShape(msoShapeOval, 74.25, 45.75, 43.5, 48.75).Select
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset7
Selection.ShapeRange.Fill.Visible = msoFalse
End If


End Sub

質問者からの補足コメント

• 

  いつもお世話になっております。
  下記のように
  Case "D"
  If IsDate(Target.Value) And IsDate(Range("D4").Value) And IsDate(Range("D5").Value) Then
  
  
  ためしたところRange("D4")に日付が入力された時点で
  msoShapeStylePreset7が出現してしまいます。

    補足日時：2019/10/27 07:56

• 説明不足で申し訳ございませんでした。
  添付ファイルのようにしたいのです。
  もし、お時間があれば教えてくれませんでしょぅか。
  すみませんが宜しくお願い致します。

  
  No.5の回答に寄せられた補足コメントです。 補足日時：2019/10/27 21:38

• 

  失礼いたしました。
  どちらかが、空白セルなら、
  オートシェイプを非表示
  申し訳ございませんでした。
  よろしくお願いいたします。

    補足日時：2019/10/27 21:39

No.7 ベストアンサー 回答者： tatsu99 回答日時： 2019/10/27 22:37

以下のようになります。

オートシェイプの位置は、調整してください。
右側のオートシェイプは、Ｆ１２、Ｆ１３のセルを見ています。（Ｇ１２，Ｇ１３は誤記と解釈します）
Private Sub Worksheet_Change(ByVal Target As Range)
Dim st As String
Dim cnt As Long
Dim shape_obj As Object
With Target
st = Left(.Address(0, 0), IIf(.Address(0, 0) Like "[A-Z][A-Z]*", 2, 1))
Select Case st
Case "D"
If Target.Row <> 4 And Target.Row <> 5 Then Exit Sub
If IsDate(Range("D4").Value) And IsDate(Range("D5").Value) Then
If shape_exist("Dshape", shape_obj) = False Then
ActiveSheet.Shapes.AddShape(msoShapeOval, 74.25, 45.75, 43.5, 48.75).Select
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset7
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.name = "Dshape"
Else
shape_obj.Visible = msoTrue
End If
Else
If shape_exist("Dshape", shape_obj) = True Then
shape_obj.Visible = msoFalse
End If
End If
Case "F"
If Target.Row <> 12 And Target.Row <> 13 Then Exit Sub
If IsDate(Range("F12").Value) And IsDate(Range("F13").Value) Then
If shape_exist("Fshape", shape_obj) = False Then
ActiveSheet.Shapes.AddShape(msoShapeOval, 237.75, 138.75, 43.5, 48.75).Select
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset7
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.name = "Fshape"
Else
shape_obj.Visible = msoTrue
End If
Else
If shape_exist("Fshape", shape_obj) = True Then
shape_obj.Visible = msoFalse
End If
End If
End Select
End With

End Sub

Private Function shape_exist(ByVal name As String, ByRef shape_obj) As Boolean
Dim wshape As Object
shape_exist = False
For Each wshape In ActiveSheet.Shapes
If wshape.name = name Then
shape_exist = True
Set shape_obj = wshape
Exit Function
End If
Next
End Function

この回答へのお礼

まだ検証しておりませんがすごいって感じが致します
明日休みなのでやって見ます
ありがとうございました

お礼日時：2019/10/27 23:09

No.6 回答者： tatsu99 回答日時： 2019/10/27 17:37

Ｎｏ５です。

添付図を忘れてました。追加します。

No.5 回答者： tatsu99 回答日時： 2019/10/27 17:35

>下記のように

>Case "D"
>If IsDate(Target.Value) And IsDate(Range("D4").Value) And IsDate(Range("D5").Value) Then
>ためしたところRange("D4")に日付が入力された時点で
>msoShapeStylePreset7が出現してしまいます。

私が書いた回答は、以下のようにすることです。
Case "E"
If IsDate(.Value) And IsDate(Range("D4").Value) And IsDate(Range("D5").Value) Then

既存のマクロ（あなたが質問で提示したマクロ）は、添付図のように、E列（例えば緑のセル）に日付を入力したとき、
オートシェイプを表示するものと理解しました。
今回の要望は、E列に日付が入力されたとき、D3、D4（黄色のセル）が日付なら、オートシェイプを表示する
と理解したのですが、違ったでしょうか。

もしそうであれば、どのようにされたいのか、再度提示していただけませんでしょうか。（画像も添えていただければ助かります）

No.4 回答者： GooUserラック 回答日時： 2019/10/27 14:58

No.3 の訂正です。

最初有った「IF 文」が抜けてました。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim st As String
Dim cnt As Long
　If IsDate(Target.Value) Then
　　Select Case Target.Column
　　　Case 4 'D列
　　　　If IsDate(Cells(Target.Row, 5).Value) Then
　　　　　ActiveSheet.Shapes.AddShape(msoShapeOval, 74.25, 45.75, 43.5, 48.75).Select
　　　　　Selection.ShapeRange.ShapeStyle = msoShapeStylePreset7
　　　　　Selection.ShapeRange.Fill.Visible = msoFalse
　　　　End If
　　　Case 5 'E列
　　　　If IsDate(Cells(Target.Row, 4).Value) Then
　　　　　ActiveSheet.Shapes.AddShape(msoShapeOval, 74.25, 45.75, 43.5, 48.75).Select
　　　　　Selection.ShapeRange.ShapeStyle = msoShapeStylePreset7
　　　　　Selection.ShapeRange.Fill.Visible = msoFalse
　　　　End If
　　End Select
　End If
End Sub

※ 大変申し訳ございませんでした。

No.3 回答者： GooUserラック 回答日時： 2019/10/27 08:49

先ほどは全部書きませんでしたがこちらでは問題なく動きますよ。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim st As String
Dim cnt As Long
　Select Case Target.Column
　　Case 4 'D列
　　　If IsDate(Cells(Target.Row, 5).Value) Then
　　　　ActiveSheet.Shapes.AddShape(msoShapeOval, 74.25, 45.75, 43.5, 48.75).Select
　　　　Selection.ShapeRange.ShapeStyle = msoShapeStylePreset7
　　　　Selection.ShapeRange.Fill.Visible = msoFalse
　　　End If
　　Case 5 'E列
　　　If IsDate(Cells(Target.Row, 4).Value) Then
　　　　ActiveSheet.Shapes.AddShape(msoShapeOval, 74.25, 45.75, 43.5, 48.75).Select
　　　　Selection.ShapeRange.ShapeStyle = msoShapeStylePreset7
　　　　Selection.ShapeRange.Fill.Visible = msoFalse
　　　End If
　End Select
End Sub

No.2 回答者： GooUserラック 回答日時： 2019/10/27 02:28

列対応なら

If IsDate(Target.Value) Then
　Select Case Target.Column
　　Case 4
　　　If IsDate(Cells(Target.Row, 5).Value) Then
　　　　'処理
　　Case 5
　　　If IsDate(Cells(Target.Row, 4).Value) Then
　　　　'処理
　End Select
End If

No.1 回答者： tatsu99 回答日時： 2019/10/26 23:42

If IsDate(.Value) Then を

If IsDate(.Value) And IsDate(Range("D4").Value) And IsDate(Range("D5").Value) Then
にしてください。