47

view

こんな感じで如何でしょうか。

その前にコードを見て気付いた点をいろいろ・・・

> Set a = Range("A6")
なのに
> For Each a In abchk
a をループ ↑ のElementで使っていて変ですよ。
Set a は意味無し。 a は範囲 abchk に反映されていないかと・・・
> Set abchk = Range("f46").End(xlUp).Offset(0, -4)
abchkは、単体セルです。
よって
> For Each a In abchk
でループする意味がありません。
> If Range(a, abchk) <> "" Then
aとabchkは、同じものです。
もし、違うときは、配列になりますので、<> "" 等 値の比較は、出来ません。
あと、入力1セルずつ何回もCall completionをCallするんですか？
全体が入力OKでCall するのと違いますか？

なお、いちいち全範囲をループでチェックしないで Findメソッドで、
直接探すようにした方が、効率的と思います。

Sub Test2()
Dim Rw As Long
Dim Rng As Range
Dim abchk As Range
Rw = Cells(Rows.Count, 6).End(xlUp).Row
Set abchk = Range("A6:B" & Rw & ",D6:D" & Rw)
For Each Rng In abchk
    If Rng.Value <> "" Then
        Call completion
    Else
        Rng.Activate
        MsgBox Rng.Address(False, False) & _
            " 必須項目に対し、空白のセルがあります" & _
            vbNewLine & "全て入力して下さい", vbExclamation
        ' Exit Sub '         <--- 1回のMsgで終わるとき有効にします。
    End If
Next
Set abchk = Nothing
End Sub

'-----

全体が入力OKのときだけcompletionをCall するとき

Sub test3()
Dim Rw As Long
Dim Rng As Range
Dim abchk As Range
Dim Flg As Boolean
Rw = Cells(Rows.Count, 6).End(xlUp).Row
Set abchk = Range("A6:B" & Rw & ",D6:D" & Rw)
For Each Rng In abchk
    If Rng.Value = "" Then
        Flg = True
        Rng.Activate
        MsgBox Rng.Address(False, False) & _
            " 必須項目に対し、空白のセルがあります" & _
            vbNewLine & "全て入力して下さい", vbExclamation
        ' Exit Sub '         <--- 1回のMsgで終わるとき有効にします。
    End If
Next
If Flg = False Then Call completion
Set abchk = Nothing
End Sub