从 IEEE-754 double in VBA 中提取尾数、指数和符号数据

Question

如何从 VBA 中的 IEEE-754 64 位（双精度）浮点数中提取尾数、指数和符号数据？谢谢

编辑（在 John Coleman 评论之后）。在发布原始问题之前，我四处寻找解决方案，但只能找到如何在 C 中执行此操作（例如，使用带位域的结构）。找不到 VBA 的任何内容。我试过使用 VBA 的位运算符（即 AND、OR、NOT、XOR），但这似乎没有给出预期的结果。例如1用单精度IEEE 32位浮点表示表示为

0 01111111 00000000000000000000000

其中第一位用于符号，接下来的 8 位用于（偏置）指数，最后 23 位用于尾数。将 NOT 应用于 1 应该 return

1 10000000 11111111111111111111111

也就是十进制的-3.9999998，但是下面的代码在VBAreturns -2，表示为

1 10000000 00000000000000000000000

x = Not 1!
Debug.Print x

我没有看到在我的 OP 中发布这个的意义。

Answer 1

部分答案：

VBA 按位运算符设计用于处理整数或长数据。考虑以下因素：

Sub test()
    Dim x As Single, y As Single
    x = 1#
    y = Not x
    Debug.Print y
    Debug.Print TypeName(Not x)
End Sub

输出：

-2 
Long

第一行输出是观察到的怪异现象。第二行是对这个怪事的解释。显然，x 在输入 Not 之前被转换为 long。有趣的是，下面的 C 程序也打印 -2:

int main(void){
    int x,y;
    x = 1;
    y = ~x;
    printf("%d\n",y);
    return 0;
}

(gcc 在我的机器上使用 32 位整数，所以这里的 int 相当于 VBA 中的 Long)

应该可以得到你想要的，但按位运算符不是办法。

Answer 2

我想我已经找到方法了。下面的函数 DoubleToBin returns 一个 64 位的字符串，表示一个 IEEE-754 双精度浮点数。它使用 VBA "trick" 通过将 LSet 与相同大小的用户定义类型相结合，在不使用 API 例程（例如 MemCopy (RtlMoveMemory)）的情况下传递原始数据。一旦我们有了位串，我们就可以从中提取所有组件。

Type TDouble
  Value As Double
End Type

Type TArray
  Value(1 To 8) As Byte
End Type

Function DoubleToArray(DPFloat As Double) As Variant
  Dim A As TDouble
  Dim B As TArray
  A.Value = DPFloat 
  LSet B = A
  DoubleToArray = B.Value
End Function

Function DoubleToBin(DPFloat As Double) As String
  Dim ByteArray() As Byte
  Dim BitString As String
  Dim i As Integer
  Dim j As Integer

  ByteArray = DoubleToArray(DPFloat)

  For i = 8 To 1 Step -1
    j = 2 ^ 7
    Do While j >= 1
      If (ByteArray(i) And j) = 0 Then
        BitString = BitString & "0"
      Else
        BitString = BitString & "1"
      End If
      j = j \ 2
    Loop
  Next i

  DoubleToBin = BitString
End Function

它在这里如何运作 - 我现在接受我自己的答案了吗？

Answer 3

这是对Confounded 优秀答案的修改。我修改了他们的功能以使用内置函数 Hex 而不是按位操作来获取位模式，使其能够灵活地处理单精度和双精度，并且 return十六进制（默认）或二进制的结果：

Type TDouble
  Value As Double
End Type

Type TSingle
  Value As Single
End Type

Type DArray
  Value(1 To 8) As Byte
End Type

Type SArray
  Value(1 To 4) As Byte
End Type

Function DoubleToArray(DPFloat As Double) As Variant
  Dim A As TDouble
  Dim B As DArray
  A.Value = DPFloat
  LSet B = A
  DoubleToArray = B.Value
End Function

Function SingleToArray(SPFloat As Single) As Variant
  Dim A As TSingle
  Dim B As SArray
  A.Value = SPFloat
  LSet B = A
  SingleToArray = B.Value
End Function

Function HexToBin(hDigit As String) As String
    Select Case hDigit
        Case "0": HexToBin = "0000"
        Case "1": HexToBin = "0001"
        Case "2": HexToBin = "0010"
        Case "3": HexToBin = "0011"
        Case "4": HexToBin = "0100"
        Case "5": HexToBin = "0101"
        Case "6": HexToBin = "0110"
        Case "7": HexToBin = "0111"
        Case "8": HexToBin = "1000"
        Case "9": HexToBin = "1001"
        Case "A": HexToBin = "1010"
        Case "B": HexToBin = "1011"
        Case "C": HexToBin = "1100"
        Case "D": HexToBin = "1101"
        Case "E": HexToBin = "1110"
        Case "F": HexToBin = "1111"
    End Select
End Function

Function ByteToString(B As Byte, Optional FullBinary As Boolean = False)
    Dim BitString As String
    BitString = Hex(B)
    If Len(BitString) < 2 Then BitString = "0" & BitString
    If FullBinary Then
        BitString = HexToBin(Mid(BitString, 1, 1)) & HexToBin(Mid(BitString, 2, 1))
    End If
    ByteToString = BitString
End Function

Function FloatToBits(float As Variant, Optional FullBinary As Boolean = False) As String
    Dim ByteArray() As Byte
    Dim BitString As String
    Dim i As Integer, n As Integer
    Dim x As Double, y As Single
    If TypeName(float) = "Double" Then
        n = 8
        x = float
        ByteArray = DoubleToArray(x)
    ElseIf TypeName(float) = "Single" Then
        n = 4
        y = float
        ByteArray = SingleToArray(y)
    Else
        FloatToBits = "Error!"
        Exit Function
    End If

    For i = n To 1 Step -1
        BitString = BitString & ByteToString(ByteArray(i), FullBinary)
    Next i
    FloatToBits = BitString
End Function

这是一个测试：

Sub test()
    Dim x As Single, y As Double
    x = Application.WorksheetFunction.Pi()
    y = Application.WorksheetFunction.Pi()

    Debug.Print FloatToBits(x)
    Debug.Print FloatToBits(x, True)
    Debug.Print FloatToBits(y)
    Debug.Print FloatToBits(y, True)
End Sub

输出：

40490FDB
01000000010010010000111111011011
400921FB54442D18
0100000000001001001000011111101101010100010001000010110100011000

当我将 400921FB54442D18 输入 this 在线工具时，我得到了 3.141592653589793，这很有意义。

有点奇怪，当我将其应用于 10.4 时，我得到

0100000000100100110011001100110011001100110011001100110011001101

与 this Excel VBA 中关于浮动的优秀文章中的示例在最后位置不同。两个版本都为 10.4（很多很多地方）。我不太清楚这种差异是怎么回事。

Answer 4

此函数适用于 64 位双精度格式：

Function IEEE754todouble(hexanumber As String) As Double

    If Left(hexanumber, 1) > 7 Then
        sign = 1
    Else
        sign = 0
    End If
    
    exponent = Val("&H" & (Left(hexanumber, 3))) Mod 2048
    
    mantissa = 16 ^ 8 * Val("&H" & Mid(hexanumber, 4, 5)) + Val("&H" & Right(hexanumber, 8))
    IEEE754todouble = (-1) ^ sign * 2 ^ (exponent - 1023) * (1 + 2 ^ -52 * mantissa)

End Function

如果需要其他格式，只需要在里面改几个数字就可以了。

我在尾数中进行了双重计算，因为这家伙不想知道一个 Val("&H" & Right(hexanumber, 13))。

从 IEEE-754 double in VBA 中提取尾数、指数和符号数据

Extract mantissa, exponent and sign data from IEEE-754 double in VBA

floating-point

double

excel

vba

floating-point-conversion

0 01111111 00000000000000000000000

1 10000000 11111111111111111111111

1 10000000 00000000000000000000000