Double型で非数(NaN・Not a Number)・正の無限大(PositiveInfinity)・負の無限大(NegativeInfinity)を定義したり、値が該当するかを判定したりする。
使い所があるかどうかは不明……。
Created
December 5, 2024 13:07
-
-
Save furyutei/696555c7bd447b8749ef02845ae7b0d5 to your computer and use it in GitHub Desktop.
[VBA] NaNや無限大を扱う
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Option Explicit | |
| Private Declare PtrSafe Sub RtlMoveMemory Lib "Kernel32" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As LongPtr) | |
| Public Property Get NaN() As Double | |
| On Error Resume Next | |
| NaN = 0# / 0# | |
| End Property | |
| Public Property Get PositiveInfinity() As Double | |
| On Error Resume Next | |
| PositiveInfinity = 1# / 0# | |
| End Property | |
| Public Property Get NegativeInfinity() As Double | |
| On Error Resume Next | |
| NegativeInfinity = -1# / 0# | |
| End Property | |
| Public Function IsNaN(ByVal Value As Double) As Boolean | |
| ' [備忘] NaNはNaN自身やその他の数値と比較演算子では比較できない(オーバーフローになる) | |
| Dim ValueBytes As Variant: ValueBytes = ConvertDoubleToBytes(Value) | |
| IsNaN = (ValueBytes(UBound(ValueBytes) - 1) = &HF8) And (ValueBytes(UBound(ValueBytes)) = &HFF) | |
| End Function | |
| Public Function IsInfinity(ByVal Value As Double) As Boolean | |
| ' IsInfinity = (Value = PositiveInfinity) Or (Value = NegativeInfinity) ' ValueがNaNの場合にエラー | |
| IsInfinity = IsPositiveInfinity(Value) Or IsNegativeInfinity(Value) | |
| End Function | |
| Public Function IsPositiveInfinity(ByVal Value As Double) As Boolean | |
| ' IsPositiveInfinity = (Value = PositiveInfinity) ' ValueがNaNの場合にエラー | |
| Dim ValueBytes As Variant: ValueBytes = ConvertDoubleToBytes(Value) | |
| IsPositiveInfinity = (ValueBytes(UBound(ValueBytes) - 1) = &HF0) And (ValueBytes(UBound(ValueBytes)) = &H7F) | |
| End Function | |
| Public Function IsNegativeInfinity(ByVal Value As Double) As Boolean | |
| ' IsNegativeInfinity = (Value = NegativeInfinity) ' ValueがNaNの場合にエラー | |
| Dim ValueBytes As Variant: ValueBytes = ConvertDoubleToBytes(Value) | |
| IsNegativeInfinity = (ValueBytes(UBound(ValueBytes) - 1) = &HF0) And (ValueBytes(UBound(ValueBytes)) = &HFF) | |
| End Function | |
| Private Function ConvertDoubleToBytes(ByVal Value As Double) As Variant | |
| Dim ValueBytes(1 To LenB(Value)) As Byte | |
| Call RtlMoveMemory(ByVal VarPtr(ValueBytes(1)), Value, LenB(Value)) | |
| ConvertDoubleToBytes = ValueBytes | |
| End Function |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Option Explicit | |
| Private Sub TestPrint(ValueName, Value As Double) | |
| On Error Resume Next | |
| Dim SmallerThanZero: SmallerThanZero = Value < 0# | |
| Dim EqualThanZero: EqualThanZero = Value = 0# | |
| Dim LargerThanZero: LargerThanZero = Value > 0# | |
| Debug.Print ValueName; Tab(20); Value; Tab(40); "<0:" & SmallerThanZero, "=0:" & EqualThanZero, ">0:" & LargerThanZero | |
| End Sub | |
| Sub Test() | |
| TestPrint "PositiveInfinity", PositiveInfinity | |
| TestPrint "NegativeInfinity", NegativeInfinity | |
| TestPrint "NaN", NaN | |
| End Sub | |
| Sub Test2() | |
| Dim Foo As Double | |
| Foo = 1.79769313486231E+308: Debug.Print Foo & " < PositiveInfinity :" & (Foo < PositiveInfinity) | |
| Foo = -1.79769313486231E+308: Debug.Print "NegativeInfinity < " & Foo & ":" & (NegativeInfinity < Foo) | |
| End Sub | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment