Question

我有一个宏来格式化电子表格。我需要一些excel vba代码添加到开头，以检查列中的Quantity始终是＆＃39; 1＆＃39;

代码需要检查H2中单元格H2到数据底部的列（直到找到空白单元格）。

如果所有值都是＆＃39; 1＆＃39;什么都不做，继续运行宏。如果找到任何其他数字（负数或正数），则显示MsgBox "Warning: Quantities Other Than '1' Found. Fix Errors and Re-Run!"，然后“确定”。被选中退出宏。

Answer 1

这样的事情：

Sub YourExistingCode()
    If QuantityErrorFound Then
        MsgBox "Warning: Quantities Other Than '1' Found. Fix Errors and Re-Run!"
        Exit Sub
    Else
        '~~> Run your code
    End If
End Sub

Function QuantityErrorFound() As Boolean
    Dim cl As Range, result As Boolean

    result = False

    For Each cl In Range("H2:H" & Range("H2").End(xlDown).Row)
        If cl.Value <> 1 Then
            result = True
        End If
    Next cl

    QuantityErrorFound = result
End Function

我使用了一个函数（QuantityErrorFound），以便更容易集成到现有代码中
在现有代码中，只需添加if语句即可检查是否找到错误

Answer 2

对Alex P的代码实际上略有改变。当你处理1时，一个简单的总和将比一个循环更快

Function QuantityErrorFound() As Boolean
    Dim result As Boolean
    Dim lastR as long
    Dim sumCells as long
    Dim cntCells as Long 
    result = False

    'lastR = Range("H2").End(xlDown).Row
    lastR= Cells(rows.count, Range("H2").Column).End(Excel.xlUp).Row  '<< assuming below the last cell is empty then this is a better approach to above line.

    sumCells = Excel.Application.Sum(Range("H2:H" & lastR))
    cntCells = Range("H2:H" & lastR).cells.count
    if (sumCells = cntCells) then
       result = True
    end if

    QuantityErrorFound = result
End Function

在我的工作电子表格中，我会在隐藏的单元格中使用公式（命名范围称为“ErrorCheck”），如下所示：

=if(countif(H2:H10000,"<>1")>0,"error","ok")

然后在我的vba我需要的是以下内容：

if ((range("ErrorCheck") = "error") then
   MsgBox "Warning: Quantities Other Than '1' Found. Fix Errors and Re-Run!"
else
   ...
   ...

修改

请看Ian Cook指出的支票中的缺陷。我将按原样保留代码 - 但如果使用上述内容，则应强制列H中的值为1或0。这可以通过一个简单的公式来完成：

=if(<current formula>=1,1,0)

或

=1*(<current formula>=1)

或者，通过将Sum中的vba更改为countIf来保护Ian可能出现的问题：

Function QuantityErrorFound() As Boolean
    Dim result As Boolean
    Dim lastR as long
    Dim sumCells as long
    Dim cntCells as Long 
    result = False

    'lastR = Range("H2").End(xlDown).Row
    lastR= Cells(rows.count, Range("H2").Column).End(Excel.xlUp).Row  '<< assuming below the last cell is empty then this is a better approach to above line.

    sumCells = Excel.Application.WorksheetFunction.CountIf(Range("H2:H" & lastR),"=1")  '<<not tested and may need to read ...,1)
    cntCells = Range("H2:H" & lastR).cells.count
    if (sumCells = cntCells) then
       result = True
    end if

    QuantityErrorFound = result
End Function

如果使用上述内容，则可以简化为以下内容：

Function QuantityErrorFound() As Boolean
    Dim result As Boolean
    Dim lastR as long
    Dim sumCells as long
    result = False

    lastR= Cells(rows.count, Range("H2").Column).End(Excel.xlUp).Row 

    sumCells = Excel.Application.WorksheetFunction.CountIf(Range("H2:H" & lastR),"<>1")  
    if (sumCells = 0) then
       result = True
    end if

    QuantityErrorFound = result
End Function

Excel Vba代码检查列中的数量

2 个答案: