White N
White N
Programming language:VBA
2021-03-01 13:12:40
0
Q:

excel vba initialize or detect NaN infinity infinity special values

Lazy Locust
Lazy Locust
Code: VBA
2021-03-01 13:18:21 
'VBA function to create and detect IEEE 754 Floating-Point Arithmetic
'special values in the Double data type.

'To create a special value:
MsgBox SpecialVal("PosQNaN")		 'displays: 1.#QNAN
MsgBox SpecialVal("NegMin")			 'displays: -1.79769313486232E+308

'To detect if a Double variable is a special value:
MsgBox SpecialVal("NegINaN", dblVal) 'displays: True or False

'--------------------------------------------------------------------
'List of supported special value types:
'PosINFI, NegINFI, PosQNaN, NegQNaN, NegINaN
'NegMin, NegMax, PosMin, PosMax
'--------------------------------------------------------------------

'Place the following into a new standard code module:

Option Explicit

Type i4
  a%(1 To 4)
End Type

Type d1
  d As Double
End Type

Function SpecialVal(typ, Optional n)
    Dim a As d1, b As i4, s
    s = SpecialsMap(typ)
    If IsEmpty(s) Then SpecialVal = "Unrecognized type: '" & typ & "'.": Exit Function
    If Not IsMissing(n) And IsNumeric(n) = 0 Then SpecialVal = "Unrecognized type: '" & n & "'.": Exit Function
    SpecialVal = False
    If IsMissing(n) Then
        b.a(4) = s(1): b.a(1) = s(3)
        If UBound(s) > 3 Then
            b.a(3) = s(2)
            b.a(2) = s(3)
            b.a(1) = s(4)
        End If
        LSet a = b
        SpecialVal = a.d
    Else
        a.d = n: LSet b = a
        If b.a(4) >= s(1) And b.a(4) <= s(2) Then
            If UBound(s) > 3 Then If b.a(3) >= s(2) And b.a(2) <= s(3) And b.a(1) <= s(4) Then SpecialVal = True: Exit Function
            SpecialVal = True
        End If
    End If
End Function
  
Function SpecialsMap(typ)
    Dim e, t, v
    Const MAP1 = "PosINFI:7FF0:7FF0:0|NegINFI:FFF0:FFF0:0|PosQNaN:7FF8:7FFF:0|NegQNaN:FFF8:FFFF:1|NegINaN:FFF8:FFF8:0|"
    Const MAP2 = "NegMin:FFEF:FFFF:FFFF:FFFF|NegMax:8000:8000:1|PosMin:0:0:1|PosMax:7FEF:FFFF:FFFF:FFFF"
    t = LCase(typ)
    For Each e In Split(LCase(MAP1 & MAP2), "|")
    If InStr(e, t) Then
            v = Split(e, ":"): v(1) = val("&H" & v(1)): v(2) = val("&H" & v(2))
            If UBound(v) > 3 Then
                v(3) = val("&H" & v(3)): v(4) = val("&H" & v(4))
            End If
            Exit For
        End If
    Next
    SpecialsMap = v
End Function

'--------------------------------------------------------------------

'Reference:
'    https://devblogs.microsoft.com/oldnewthing/20130221-00/?p=5183    
'    https://babbage.cs.qc.cuny.edu/IEEE-754.old/IEEE-754references.html
    
'Notes:	VBA cannot create or detect the following special values:	
'		Signaling NaN, either pos or neg. Causes Overflow error.
'		Positive Indefinite NaN. VBA returns a '1.#QNAN'. 
'		Negative Zero. VBA instantly changes this to a normal zero.
2
Josias Cardoso
Josias Cardoso
Code: VBA
2021-03-01 18:18:12 
'VBA function to create and detect IEEE 754 Floating-Point Arithmetic
'special values in the Double data type.

'To create a special value:
MsgBox SpecialVal("PosQNaN")		 'displays: 1.#QNAN
MsgBox SpecialVal("NegMin")			 'displays: -1.79769313486232E+308

'To detect if a Double variable is a special value:
MsgBox SpecialVal("NegINaN", dblVal) 'displays: True or False

'--------------------------------------------------------------------
'List of supported special value types:
'PosINFI, NegINFI, PosQNaN, NegQNaN, NegINaN
'NegMin, NegMax, PosMin, PosMax
'--------------------------------------------------------------------

'Place the following into a new standard code module:

Option Explicit

Type i4
  a%(1 To 4)
End Type

Type d1
  d As Double
End Type

Function SpecialVal(typ, Optional n)
    Dim a As d1, b As i4, s
    s = SpecialsMap(typ)
    If IsEmpty(s) Then SpecialVal = "Unrecognized type: '" & typ & "'.": Exit Function
    If Not IsMissing(n) And IsNumeric(n) = 0 Then SpecialVal = "Unrecognized type: '" & n & "'.": Exit Function
    SpecialVal = False
    If IsMissing(n) Then
        b.a(4) = s(1): b.a(1) = s(3)
        If UBound(s) > 3 Then
            b.a(3) = s(2)
            b.a(2) = s(3)
            b.a(1) = s(4)
        End If
        LSet a = b
        SpecialVal = a.d
    Else
        a.d = n: LSet b = a
        If b.a(4) >= s(1) And b.a(4) <= s(2) Then
            If UBound(s) > 3 Then If b.a(3) >= s(2) And b.a(2) <= s(3) And b.a(1) <= s(4) Then SpecialVal = True: Exit Function
            SpecialVal = True
        End If
    End If
End Function
  
Function SpecialsMap(typ)
    Dim e, t, v
    Const MAP1 = "PosINFI:7FF0:7FF0:0|NegINFI:FFF0:FFF0:0|PosQNaN:7FF8:7FFF:0|NegQNaN:FFF8:FFFF:1|NegINaN:FFF8:FFF8:0|"
    Const MAP2 = "NegMin:FFEF:FFFF:FFFF:FFFF|NegMax:8000:8000:1|PosMin:0:0:1|PosMax:7FEF:FFFF:FFFF:FFFF"
    t = LCase(typ)
    For Each e In Split(LCase(MAP1 & MAP2), "|")
    If InStr(e, t) Then
            v = Split(e, ":"): v(1) = val("&H" & v(1)): v(2) = val("&H" & v(2))
            If UBound(v) > 3 Then
                v(3) = val("&H" & v(3)): v(4) = val("&H" & v(4))
            End If
            Exit For
        End If
    Next
    SpecialsMap = v
End Function

'--------------------------------------------------------------------

'Reference:
'    https://devblogs.microsoft.com/oldnewthing/20130221-00/?p=5183
'    https://babbage.cs.qc.cuny.edu/IEEE-754.old/IEEE-754references.html
    
'Notes:	VBA cannot create or detect the following special values:	
'		Signaling NaN, either pos or neg. Causes Overflow error.
'		Positive Indefinite NaN. VBA returns a '1.#QNAN'. 
'		Negative Zero. VBA instantly changes this to a normal zero.
1

Tags

Related

New to Communities?

Join the community