Убедитесь, что все значения в диапазоне идентичны

Question

Мне нужно отобразить окно сообщения, когда все значения в диапазоне на моей таблице равны нулю. В настоящее время я использую следующий код:

Dim Cell As Range 
For Each Cell In Range("E17:E25") 
    If Cell.Value = "0" Then 
    MsgBox ("If hardware is required, please manually populate the corresponding sections.") 
    End If 
Next 

отображается сообщение, однако показан 9 раз (для каждого из ячеек в диапазоне). Мне нужно проверить, все ли значения в диапазоне E17:E25 равны нулю, а затем отображать только одно окно сообщения. Есть идеи?

Спасибо.

Answer 1

'something like this 
Dim isDataPresent as boolean 
isDataPresent = true 
for each Cell in Range(....) 
    if cell.value = "0" then 
     isDataPresent = false 
     exit for 
    end if 
next 
if not isDataPresent then 
    show message box here 
end if 

Answer 2

Вы хотите знать, если все значения равны 0? Вы не можете просто сделать

If WorksheetFunction.Sum(Range("E17:E25")) = 0 Then MsgBox ("If hardware is required, please manually populate the corresponding sections.")

Нет необходимости в петлях.

Edit: Если вы хотите, чтобы проверить любое другое число, и если все ячейки это число, вы можете сделать это:

Sub t() 
Dim rng As Range 
Dim myNum as Long 
myNum = 1 
Set rng = Range("B3:B6") 
If WorksheetFunction.CountIf(rng, myNum) = rng.Count Then MsgBox ("All the same!") 
End Sub 

Answer 3

И причиной есть бесконечные способы кожи кошки здесь другой подход.

Dim Cell As Range 
Dim ZeroCount As Integer 
Dim CellCount As Integer 

ZeroCount = 0 
CellCount = 0 

For Each Cell In Range("E17:E25") 
    CellCount = CellCount + 1 
    If Cell.Value = 0 Then ZeroCount = ZeroCount + 1 
Next Cell 

If ZeroCount = CellCount Then MsgBox ("If hardware is required, please manually populate the corresponding sections.") 

Answer 4

Чтобы проверить, что:

1. диапазон не содержит пустых значений
2. Все клетки являются одинаковыми

функцию

Function SameRange(rngIn As Range) As Boolean 
If Application.CountA(rngIn) = rngIn.Cells.Count Then SameRange = (Application.CountIf(rngIn, rngIn.Cells(1).Value) = rngIn.Cells.Count) 
End Function 

теста

Sub test() 
MsgBox SameRange([d1:d5]) 
End Sub