문제

I have a Macro to check if data satisfies some conditions. If it does one message box is displayed for every matched criteria.

I would like to have a unique Message Box displaying all conditions which were matched.

What is the best approach to tackle this issue? The below example is what I've got so far.

N   I   Esp             Par     T   DBH     H_m     Cod
2   111 E_cit           432     1                   1
2   111 E_cit           432     2                   1
2   111 E_cit           432     3                   1
2   111 E_cit           432     4   3       17.4    
2   111 E_cit           432     5                   
2   111 E_cit           432     6   14.48   15  

The Macro (with two conditions as examples):

Option Explicit

Dim DBH As Range
Dim Cod As Range

Sub Conditions_1()

'------------------------------------------------
'DBH should be between 5 and 45 cm

    For Each DBH In Range("F2:F7")
        If DBH < 5 And DBH <> 0 Or DBH > 45 And DBH <> 0 Then
        MsgBox "1 - DBH is not between 5 cm and 45 cm"
            Exit For
        End If
    Next DBH

'------------------------------------------------
'There can't be an empty cell on DBH column 
'together with an empty cell on the Code column

    For Each DBH In Range("F2:F7")
        If DBH = 0 And DBH.Offset(, 2) = 0 Then
        MsgBox "2 - DBH is empty and also the Code"
            Exit For
        End If
    Next DBH

 End Sub

This current code yields two message boxes separately,

  1. "1- DBH is not between 5 cm and 45 cm"
  2. "2- DBH is empty and also the Code"

but, I'd like to have a single box listing all conditions once. Any help is appreciated.

도움이 되었습니까?

해결책

Option Explicit

Dim DBH As Range
Dim Cod As Range


Sub Conditions_1()

Dim msg as string

msg=""

'------------------------------------------------
'DBH should be between 5 and 45 cm

    For Each DBH In Range("F2:F7")
        If DBH < 5 And DBH <> 0 Or DBH > 45 And DBH <> 0 Then
            msg = msg & "1 - DBH in " & DBH.Address() & _
                        " is not between 5 cm and 45 cm" & vbLf
        End If
    Next DBH

'------------------------------------------------
'There can't be an empty cell on DBH column 
'together with an empty cell on the Code column

    For Each DBH In Range("F2:F7")
        If DBH = 0 And DBH.Offset(, 2) = 0 Then
            msg = msg & "2 - DBH in " & DBH.Address() & _
                        " is empty and also the Code" & vbLf
        End If
    Next DBH

    If Len(msg) > 0 Then MsgBox msg


End Sub
라이센스 : CC-BY-SA ~와 함께 속성
제휴하지 않습니다 StackOverflow
scroll top