dポイントプレゼントキャンペーン実施中!

作業ブックのシートに下記のコードを設定しております。
このコードは指定セルに("地番調査", "許可証")のどちらかの文字が表示された場合に
文字が表示された右横のセルに「後日図書の提出をお願いいたします。」
と表示されます。
このコードを変更して
指定セルに不特定な文字が表示された場合に
右横のセルに「後日図書の提出をお願いいたします。」
と表示出来る方法を教えてください。
現状のコード

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, Range("C26:C31")) Is Nothing Then Exit Sub

Dim arr1, arr2
arr1 = Array("地番調査", "許可証")

Dim i As Long

For i = 0 To UBound(arr1)
If Target.Value = arr1(i) Then
Target.Offset(, 3).Value = "後日図書の提出をお願いいたします。"
Exit Sub
End If
Next i
End Sub

以上です。
宜しくお願い致します。

  • 画像を添付する (ファイルサイズ:10MB以内、ファイル形式:JPG/GIF/PNG)
  • 今の自分の気分スタンプを選ぼう!
あと4000文字

A 回答 (2件)

>不特定な文字


https://detail.chiebukuro.yahoo.co.jp/qa/questio …
こういう事ね

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, Range("C26:C31")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Value <> "" Then
Target.Offset(, 3).Value = "後日図書の提出をお願いいたします。"
Else
Target.Offset(, 3).Value = ""
End If
Application.EnableEvents = True
End Sub
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
上手くできました。

お礼日時:2024/06/18 15:38

>不特定な文字


"地番調査", "許可証" 以外と解釈

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, Range("C26:C31")) Is Nothing Then Exit Sub
Dim arr1
Dim Result
arr1 = Array("地番調査", "許可証")

Result = Filter(arr1, Target.Value, True)

If UBound(Result) = -1 Then
Target.Offset(, 3).Value = "後日図書の提出をお願いいたします。"
Exit Sub
End If
End Sub
    • good
    • 1

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!