未記入箇所がある場合メッセージボックス

質問

お世話になります。

未記入箇所がある場合『未記入箇所があります。』の
メッセージボックスを開きVBAを止めたいです。

-----
○A1,B1,C1,D1,F1の中で一箇所でも入力したら全て入力しないと
メッセージボックスが開く

○全て入力されていた場合、又は全て空欄の場合はメッセージボックスが開かず
そのままVBAを流したいです。
-----

A1,B1だけなら下記で良いのですが、複数となると分かりません。

If [A1] = "" Xor [B1] = "" Then
MsgBox "未記入箇所があります。"
Exit Sub
End If

すみませんが、よろしくお願いいたします。

EXCEL2010

回答No.10

kkkkkm · ベストアンサー

未記入箇所の最左のセルを選択状態にするには
No９の
Function MFind(ByVal i As Long) As Boolean
の部分を以下に変更してください。

Function MFind(ByVal i As Long) As Boolean
Dim URange As Range
Dim j As Long, k As Long

MFind = True
Set URange = Union(Range(Cells(i, "B"), Cells(i, "C")), Cells(i, "N"), Range(Cells(i, "Q"), Cells(i, "R")))
If WorksheetFunction.CountA(URange) > 0 And _
WorksheetFunction.CountA(URange) < URange.Count Then
MsgBox i & "行に未記入箇所があります。", vbInformation
For j = 1 To URange.Areas.Count
For k = 1 To URange.Areas(j).Count
If URange.Areas(j).Cells(1, k).Value = "" Then
URange.Areas(j).Cells(1, k).Select
MFind = False
Exit Function
End If
Next
Next
End If
End Function

お礼

ありがとうございます！！
完璧に出来ました！！！

自分の力では自分のVBAに入れるだけで四苦八苦しましたが、
自分が思い描いていたよりはるかに素晴らしいです。

勉強にもなりました。

ありがとうございます。

kkkkkm様をベストアンサーに選ばせていただきましたが、
ご回答頂いた皆様も本当にありがとうございました。

回答No.9

kkkkkm

訂正です。動作を止めるのを見逃してました。
Sub Example()
Dim i As Long

For i = 10 To 24
If MFind(i) = False Then Exit Sub
Next
For i = 28 To 39
If MFind(i) = False Then Exit Sub
Next
End Sub

Function MFind(ByVal i As Long) As Boolean
Dim URange As Range

MFind = True
Set URange = Union(Range(Cells(i, "B"), Cells(i, "C")), Cells(i, "N"), Range(Cells(i, "Q"), Cells(i, "R")))
If WorksheetFunction.CountA(URange) > 0 And _
WorksheetFunction.CountA(URange) < URange.Count Then
MsgBox i & "行に未記入箇所があります。", vbInformation
MFind = False
End If
End Function

回答No.8

kkkkkm

> この構文で、10～24行、28～39行と出来るでしょうか？

Sub Example()
Dim i As Long

For i = 10 To 24
Example2 (i)
Next
For i = 28 To 39
Example2 (i)
Next
End Sub

Function Example2(ByVal i As Long)
Dim URange As Range

Set URange = Union(Range(Cells(i, "B"), Cells(i, "C")), Cells(i, "N"), Range(Cells(i, "Q"), Cells(i, "R")))
If WorksheetFunction.CountA(URange) > 0 And _
WorksheetFunction.CountA(URange) < URange.Count Then
MsgBox i & "行に未記入箇所があります。", vbInformation
End If
End Function

回答No.7

HohoPapa

A10セルから下方向に空欄のセルが登場するまで行う
という条件で書いてみました。

　'//次行から
　Dim wkCntN As Long
　Dim RowCnt As Long

　With ThisWorkbook.Sheets(1)
　　RowCnt = 10
　　Do
　　　If .Cells(RowCnt, 1).Value = "" Then Exit Do
　　　wkCntN = 0
　　　If .Cells(RowCnt, 2).Value = "" Then wkCntN = wkCntN + 1
　　　If .Cells(RowCnt, 3).Value = "" Then wkCntN = wkCntN + 1
　　　If .Cells(RowCnt, 14).Value = "" Then wkCntN = wkCntN + 1
　　　If .Cells(RowCnt, 17).Value = "" Then wkCntN = wkCntN + 1
　　　If .Cells(RowCnt, 18).Value = "" Then wkCntN = wkCntN + 1
　　　If ((wkCntN <> 5) And (wkCntN <> 0)) Then
　　　　MsgBox Format(RowCnt, "0") & "行目に未記入箇所があります"
　　　　Exit Do　　　　'チェックから抜ける
　　　　'Exit sub　　　'Subルーチンを抜ける
　　　End If
　　　RowCnt = RowCnt + 1
　　Loop
　End With
　'//前行までを期待個所に挿入

回答No.6

watabe007

>『48』とは何でしょうか？
メッセージに注意のアイコンを表示します。
Sub Test()
　　Dim c As Range, f As Long

　　With Range("B10:C10,N10,Q10:R10")
　　　　f = 0
　　　　For Each c In .Cells
　　　　　　If c.Value <> "" Then f = f + 1
　　　　Next
　　　　If f <> 0 And f <> .Count Then MsgBox "未記入箇所があります。", 48
　　End With
End Sub

補足

ありがとうございます。

＞メッセージに注意のアイコンを表示します。

そうだったんですね。
まだまだ初心者なので勉強になります。

この構文で、10～24行、28～39行と出来るでしょうか？

一つのVBA（言い方が正しいかわからないですが…）内に
入れないといけないので、自分には出来ませんでした。

回答No.5

kkkkkm

下の行がどこまでなのかわからないのでとりあえず10行と11行だとして
For i = 10 To 11の11を実際の行に変更してください。

Sub Example()
Dim i As Long
Dim URange As Range

For i = 10 To 11
Set URange = Union(Range(Cells(i, "B"), Cells(i, "C")), Cells(i, "N"), Range(Cells(i, "Q"), Cells(i, "R")))
If WorksheetFunction.CountA(URange) > 0 And _
WorksheetFunction.CountA(URange) < URange.Count Then
MsgBox i & "行に未記入箇所があります。", vbInformation
End If
Next
End Sub

補足

ありがとうございます。

この構文で、10～24行、28～39行と出来るでしょうか？

一つのVBA（言い方が正しいかわからないですが…）内に
入れないといけないので、自分には出来ませんでした。

回答No.4

HohoPapa

>(1) B10 C10 N10 Q10 R10の一箇所でも入力したら全て入力しないと
>　メッセージボックスが開く
この全てとは、B10 C10 N10 Q10 R10
この５つのセルのことですね？

>(2) D10 E10 F10 G10は結合
> 　 H10 I10は結合
> 　 K10 L10は結合
> 　 こちらは通常非表示の計算式が入っています。
> 　 (1)を入力するとそれに準じた文字（数字）が表示されます。
ここには計算式が埋まっているようですから
今回のチェックの対象にする必要はないんですね？

>(3) (1)(2)の行だけでなく、同じことを下の行にも行いたいです。
何行目までチェックすればいいですか？
例えば、
A10セルから下方向に空欄のセルが登場するまで行うとか
チェックする行数が決まっているとかが
考えられそうですがかがでしょうか？

総じていえば
B10 C10 N10 Q10 R10
　が全数埋まっている、または、全数空欄ならスルー
　それ以外ならメッセージを表示してチェックから抜ける
B11 C11 N11 Q11 R11
　が全数埋まっている、または、全数空欄ならスルー
　それ以外ならメッセージを表示してチェックから抜ける
これを繰り返すものと理解しました。
ならば、
どのような条件を満たすまで
このチェックを繰り返せばいいですか？

回答No.3

kkkkkm

入力するという事ですので数式はないと思われますのでCountAでも

Sub Example()
Dim URange As Range

Set URange = Union(Range("A1:D1"), Range("F1"))
If WorksheetFunction.CountA(URange) > 0 And _
WorksheetFunction.CountA(URange) < URange.Count Then
MsgBox "未記入箇所があります。", vbInformation
End If
End Sub

補足

早速の回答ありがとうございます。

すみません。
説明不足でした。

現状のまま記載します。

(1) B10 C10 N10 Q10 R10の一箇所でも入力したら全て入力しないと
　メッセージボックスが開く

(2) D10 E10 F10 G10は結合
　 H10 I10は結合
　 K10 L10は結合
　 こちらは通常非表示の計算式が入っています。
　 (1)を入力するとそれに準じた文字（数字）が表示されます。

(3) (1)(2)の行だけでなく、同じことを下の行にも行いたいです。

(4) 他にもVBAが入っており、その中に組み込ませたいです。

お手数取らせますがよろしくおねがいします。

回答No.2

HohoPapa

私だったら
チェックするセルたちが変動しても使いやすいコードとするために
以下のように、チェック部分を部品化します。

Option Explicit

Sub test()
　If MyCheck(Range("A1:D1,F1")) = False Then
　　MsgBox "未記入箇所があります。"
　End If
End Sub

Function MyCheck(MyRange As Range) As Boolean
'//全セルNullor全セルNull以外ならTrue
　Dim rg As Range
　Dim ct1 As Long: ct1 = 0
　Dim ct2 As Long: ct2 = 0
　MyCheck = False

　For Each rg In MyRange
　　ct1 = ct1 + 1
　　If rg.Text <> "" Then ct2 = ct2 + 1
　Next rg

　If ((ct2 = 0) Or (ct1 = ct2)) Then
　　MyCheck = True
　End If

End Function

補足

早速の回答ありがとうございます。

無知な自分には難しくテスト出来なかったです。。。

すみません。
説明不足でした。

現状のまま記載します。

(1) B10 C10 N10 Q10 R10の一箇所でも入力したら全て入力しないと
　メッセージボックスが開く

(2) D10 E10 F10 G10は結合
　 H10 I10は結合
　 K10 L10は結合
　 こちらは通常非表示の計算式が入っています。
　 (1)を入力するとそれに準じた文字（数字）が表示されます。

(3) (1)(2)の行だけでなく、同じことを下の行にも行いたいです。

(4) 他にもVBAが入っており、その中に組み込ませたいです。

お手数取らせますがよろしくおねがいします。

回答No.1

watabe007

参考に
Dim n As Long
n = Application.CountBlank(Range("A1:D1")) + Application.CountBlank(Range("F1"))
If n < 5 And n > 0 Then
　　MsgBox "『未記入箇所があります。』", 48
　　Exit Sub
End If

補足

早速の回答ありがとうございます。

一番近いような気がします。
ほぼ出来ましたが、下記の補足でのテストでは(1)のセルを全て入力
した場合もメッセージボックスが開きました。

あと、『48』とは何でしょうか？

すみません。
説明不足でした。

現状のまま記載します。

(1) B10 C10 N10 Q10 R10の一箇所でも入力したら全て入力しないと
　メッセージボックスが開く

(2) D10 E10 F10 G10は結合
　 H10 I10は結合
　 K10 L10は結合
　 こちらは通常非表示の計算式が入っています。
　 (1)を入力するとそれに準じた文字（数字）が表示されます。

(3) (1)(2)の行だけでなく、同じことを下の行にも行いたいです。

(4) 他にもVBAが入っており、その中に組み込ませたいです。

お手数取らせますがよろしくおねがいします。