Excel VBA中如何检查输入数据是否为Integer类型？

VBA没有内置的IsInteger函数，你可以通过以下几种方式实现整数类型的校验，同时结合你的现有代码完成修改：

方法1：自定义Integer校验函数（兼顾范围与精度） #

这个函数会先判断输入是否为数字，再校验是否在Integer的合法范围（-32768 到 32767），最后通过检查小数部分确认是否为整数（处理浮点数精度误差）：

Function IsIntegerValue(ByVal value As Variant) As Boolean
    If Not IsNumeric(value) Then
        IsIntegerValue = False
        Exit Function
    End If
    
    Dim num As Double
    num = CDbl(value)
    
    ' 校验是否在Integer的取值范围内
    If num < -32768 Or num > 32767 Then
        IsIntegerValue = False
        Exit Function
    End If
    
    ' 处理浮点精度问题，差值小于1e-10视为无小数部分
    IsIntegerValue = (Abs(num - Int(num)) < 1E-10)
End Function

结合你的代码修改后的完整版本 #

将上面的函数添加到你的模块中，再替换原代码的判断逻辑：

Function IsIntegerValue(ByVal value As Variant) As Boolean
    If Not IsNumeric(value) Then
        IsIntegerValue = False
        Exit Function
    End If
    
    Dim num As Double
    num = CDbl(value)
    
    If num < -32768 Or num > 32767 Then
        IsIntegerValue = False
        Exit Function
    End If
    
    IsIntegerValue = (Abs(num - Int(num)) < 1E-10)
End Function

Sub CheckColumnsHardwareDefinition()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Hardware Definition")
    Dim Target As Range
    Dim Target3 As Range
    Dim lr As Long
    Dim lr3 As Long

    Dim DblLengthMin As Double
    Dim DblLengthMax As Double
    Dim DblWeightMin As Double
    Dim DblWeightMax As Double

    Dim dynamicArray1() As String
    Dim dynamicArray2() As String

    Dim f1 As Integer
    Dim f2 As Integer
    f1 = 0
    f2 = 0

    DblLengthMax = 20000
    DblLengthMin = 5
    DblWeightMin = 0.0001
    DblWeightMax = 10000

    lr3 = Application.WorksheetFunction.Max( _
            ws.Range("A" & ws.Rows.Count).End(xlUp).Row, _
            ws.Range("B" & ws.Rows.Count).End(xlUp).Row, _
            ws.Range("C" & ws.Rows.Count).End(xlUp).Row, _
            ws.Range("D" & ws.Rows.Count).End(xlUp).Row, _
            ws.Range("E" & ws.Rows.Count).End(xlUp).Row, _
            ws.Range("F" & ws.Rows.Count).End(xlUp).Row)

    For Each Target3 In ws.Range("A2:F" & lr3)
        If IsEmpty(Target3) Then
            Target3.Interior.ColorIndex = 8
        End If
    Next Target3

    lr = Application.WorksheetFunction.Max( _
            ws.Range("C" & ws.Rows.Count).End(xlUp).Row, _
            ws.Range("D" & ws.Rows.Count).End(xlUp).Row, _
            ws.Range("E" & ws.Rows.Count).End(xlUp).Row)

    For Each Target In ws.Range("C2:E" & lr)
        ' 替换原IsNumeric判断为Integer类型检查
        If Not IsIntegerValue(Target.Value) Then
            f1 = f1 + 1
            Target.Interior.ColorIndex = 3
            ReDim Preserve dynamicArray1(0 To f1)
            dynamicArray1(f1) = "Row " & Target.Row & " Column " & Target.Column & " wrong entry: " & Target.Value
        End If

        ' 仅当是Integer时检查范围
        If IsIntegerValue(Target.Value) Then
            If Target.Value > DblLengthMax Or Target.Value < DblLengthMin Then
                f2 = f2 + 1
                Target.Interior.ColorIndex = 46
                ReDim Preserve dynamicArray2(0 To f2)
                dynamicArray2(f2) = "Row " & Target.Row & " Column " & Target.Column & " wrong entry: " & Target.Value
            End If
        End If
    Next Target

    ' 仅存在错误时弹出提示
    If f1 > 0 Then
        Dim Inhalt1 As String
        Inhalt1 = Join(dynamicArray1, vbCrLf)
        MsgBox ("Wrong datatype! " & vbCrLf & vbCrLf & f1 & " Datatype Errors (marked red)" & vbCrLf & "Only integers can be entered. Check again" & vbCrLf & Inhalt1)
    End If

    If f2 > 0 Then
        Dim Inhalt2 As String
        Inhalt2 = Join(dynamicArray2, vbCrLf)
        MsgBox ("Entries out of range!" & vbCrLf & vbCrLf & f2 & " Range errors (marked orange)" & vbCrLf & "The value is out of range. Check for unit [mm] " & vbCrLf & Inhalt2)
    End If
End Sub

关键修改说明 #

• 替换了原代码中IsNumeric的判断逻辑，改用自定义的IsIntegerValue函数
• 优化了范围检查的触发条件，仅当输入为合法Integer时才校验范围
• 调整了提示框的触发逻辑，只有存在错误时才弹出提示，避免空提示

内容的提问来源于stack exchange，提问作者FMT