Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

2516 / 76734

←次へ　｜　前へ→


	【79861】エラーメッセージ

Err - 18/5/1(火) 14:56 -


	引用なし

	パスワード

エラーメッセージで質問です。

E10:Z11・E13:Z14、E17:Z18・E20:Z21、E24:Z25・E27:Z28、E31:Z32・E34:Z35の結合セルです。
ここがNo.1の入力セルが2段あります。

AE10:BF11・AE13:BF14、AE17:BF18・AE20:BF21、AE24:BF25・AE27:BF28、AE31:BF32・AE34:BF35の結合セルです。
ここがNo.2の入力セルが2段あります。

BL11:BU13、BL18:BU20、BL25:BU27、BL32:BU34結合セルです。
ここがNo.3の入力セルが1段あります。

No.1に値が入力されていればNo.2に入力できる。
No.1に値が入力されていなければ、No.2及びNo.3には入力できずにエラーメッセージでNo.1を入力して下さい。
No.2に値が入力されていればNo.3に入力できる。
No.2に値が入力されていなければ、No.3には入力できずにエラーメッセージでNo.2を入力して下さい。

セルの一番上で説明致しますと、以下のようになります。
E17:Z18・E20:Z21以降も同じです。

E10:Z11・E13:Z14のどちらかに値が入力されていれば、AE10:BF11・AE13:BF14に入力できる。
E10:Z11・E13:Z14の両方が空白ならば、AE10:BF11・AE13:BF14とBL11:BU13は入力できずにエラーメッセージでNo.1を入力して下さい。

AE10:BF11・AE13:BF14のどちらかに値が入力されていれば、BL11:BU13は入力できる。
AE10:BF11・AE13:BF14の両方が空白ならば、BL11:BU13は入力できずにエラーメッセージでNo.2を入力して下さい。

このような処理を行いたいのですが、参考コードを
どのように直せば良いのでしょうか？
ご教授下さいませ。
宜しくお願い致します。

以下参考コードです。

Private Sub Worksheet_Change(ByVal target As Range)

　If (target.Row >= 10 And target.Row <= 11) Or _
　　 (target.Row >= 13 And target.Row <= 14) Or _
　　 (target.Row >= 17 And target.Row <= 18) Or _
　　 (target.Row >= 20 And target.Row <= 21) Or _
　　 (target.Row >= 24 And target.Row <= 25) Or _
　　 (target.Row >= 27 And target.Row <= 28) Or _
　　 (target.Row >= 31 And target.Row <= 32) Or _
　　 (target.Row >= 34 And target.Row <= 35) Then

　　Select Case target.Column
　　　Case 31
　　　　Call ShowErrMsg2(target, -1)
　　　Case 64
　　　　Call ShowErrMsg2(target, -2)
　　End Select
　　
　End If
End Sub

Sub ShowErrMsg2(ByVal target As Range, offsetCol As Integer)

　Dim result
　Dim num As Integer
　Dim errArray As Variant
　　
　errArray = Array("大項目", "中項目", "小項目", "規格", "数量")
　If target.Column > 7 Then
　　num = target.Column - 7
　Else
　　num = target.Column
　End If

　If target.Cells.Offset(0, offsetCol) = "" Then
　　If target.Cells <> "" Then
　　　result = MsgBox( _
　　　　　　　 Prompt:=errArray(num + offsetCol - 1) & "を入力してください！", _
　　　　　　　 Buttons:=vbRetryCancel + vbCritical, _
　　　　　　　 Title:="警告")
　　　　　　
　　　Select Case result
　　　　Case vbRetry
　　　　　target.Cells.Activate
　　　　　Application.SendKeys _
　　　　　　　　　　　"{F2}" & _
　　　　　　　　　　　"{Left " & Len(ActiveCell.Value) & "}" & _
　　　　　　　　　　　"+{Right " & Len(ActiveCell.Value) & "}"

　　　　Case vbCancel
　　　　　target.Cells = ""
　　　　　target.Cells.Activate
　　　End Select
　　End If

　Else
　　If target.Offset(0, -1) <> "" And offsetCol = -1 Then
　　　Exit Sub
　　End If

　　offsetCol = offsetCol + 1
　　Call ShowErrMsg2(target, offsetCol)
　End If
　　
End Sub

4 hits

▼

【79861】エラーメッセージ Err 18/5/1(火) 14:56