VBAで必須セルが満たされても、エラーメッセージが表示される

Question

フォームを保存する前に、顧客情報で特定の必須セルに記入する必要がある新しい顧客エントリのVBAコードがあります。これらのため

範囲は、

範囲B8場合：E、F、K、M、N：B10は、顧客名で充填され、次いで、対応する行のすべてのセルが列に記入しなければなりません、およびP.

範囲A13場合：A50は、顧客名とに充填され、その後、対応する行のすべてのセルが列に記入しなければならない：D、H、I、J、U.

場合いずれかのセルが空白のままになると、対応する行にフィールドがないことをユーザーに知らせる警告メッセージがポップアップ表示されます。

両方の範囲で基準が満たされると、警告メッセージは表示されず、ユーザーはフォームを保存することができます。

問題は、行8が満たされていても、行8と行13にデータが欠落しているという警告メッセージに、1つの範囲（範囲B、行8と言います）必要なすべてのデータを入力します。 （写真の強調表示されたセルはコードの一部ではありません）。私はこれがエンドユーザーを混乱させるのではないかと心配しています。

修正が必要なメッセージかIF文であるかどうかはわかりません。私は両方で遊んだが運がない。

Example

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 

Dim ws As Worksheet 
Dim rg As Range, c As Range 
Dim bCanSave As Boolean 
Dim sWarning As String 

Set ws = Sheets("Sheet1") 
Set rg = ws.Range("B8:B10, A13:A50") 
Set b = Range("B8:B10") 
Set A = Range("A13:A50") 
sWarning = "File not saved!" & vbNewLine & "Mandatory cells missing in rows: " & vbNewLine 

With ws 
    bCanSave = True 
    For Each c In rg 
     If Not IsEmpty(c) Then 
      If .Cells(b.Row, "E") = "" Or .Cells(b.Row, "F") = "" Or _ 
       .Cells(b.Row, "K") = "" Or .Cells(b.Row, "M") = "" Or _ 
       .Cells(b.Row, "N") = "" Or .Cells(b.Row, "P") = "" Or _ 
       .Cells(A.Row, "D") = "" Or .Cells(A.Row, "E") = "" Or _ 
       .Cells(A.Row, "H") = "" Or .Cells(A.Row, "I") = "" Or _ 
       .Cells(A.Row, "J") = "" Or .Cells(A.Row, "U") = "" Then 

       bCanSave = False 
       bCanClose = False 
       sWarning = sWarning & c.Row & ", " 

      End If 
     End If 
    Next c 
End With 

If Not bCanSave Then 
    MsgBox sWarning, vbExclamation 
    Cancel = True 
End If 

End Sub 

Answer 1

あなたは範囲を分割し、二つの独立したループを実行する必要があるとしている。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 

Dim ws As Worksheet 
Dim a As Range, c As Range, b as range 
Dim bCanSave As Boolean 
Dim sWarning As String 

Set ws = Sheets("Sheet1") 

Set b = ws.Range("B8:B10") 
Set a = ws.Range("A13:A50") 
sWarning = "File not saved!" & vbNewLine & "Mandatory cells missing in rows: " & vbNewLine 

With ws 
    bCanSave = True 
    For Each c In b 
     If Not IsEmpty(c) Then 
      If .Cells(c.Row, "E") = "" Or .Cells(c.Row, "F") = "" Or _ 
       .Cells(c.Row, "K") = "" Or .Cells(c.Row, "M") = "" Or _ 
       .Cells(c.Row, "N") = "" Or .Cells(b.Row, "P") = "" Then 
       bCanSave = False 
       bCanClose = False 
       sWarning = sWarning & c.Row & ", " 

      End If 
     End If 
    Next c 
    For Each c In a 
     If Not IsEmpty(c) Then 
      If .Cells(c.Row, "D") = "" Or .Cells(c.Row, "E") = "" Or _ 
       .Cells(c.Row, "H") = "" Or .Cells(c.Row, "I") = "" Or _ 
       .Cells(c.Row, "J") = "" Or .Cells(c.Row, "U") = "" Then 

       bCanSave = False 
       bCanClose = False 
       sWarning = sWarning & c.Row & ", " 

      End If 
     End If 
    Next c 
End With 

If Not bCanSave Then 
    MsgBox sWarning, vbExclamation 
    Cancel = True 
End If