Question

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

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

表示

0 01111111 00000000000000000000000

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

1 10000000 11111111111111111111111

，小数为-3.9999998，但VBA中的以下代码返回-2，由

表示

1 10000000 00000000000000000000000

x = Not 1!
Debug.Print x

我没有看到在我的OP中发布此内容的重点。

Answer 1

我想我已经找到了做到这一点的方法。以下函数DoubleToBin返回64位的字符串，表示IEEE-754双浮点数。它使用VBA＆＃34;技巧＆＃34;通过将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 2

这是对Confounded的优秀答案的修改。我修改了它们的函数，使用内置函数Hex而不是逐位运算来获得位模式，使它能够灵活地处理单精度和双精度，并返回结果十六进制（默认）或二进制：

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

与Excel VBA中浮点数的this优秀文章中的示例的最终位置不同。两个版本都是10.4（到很多很多地方）。我不太清楚如何解决这种差异。

Answer 3

部分答案：

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之前被转换为很长时间。有趣的是，以下C程序也打印-2：

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

（gcc在我的机器上使用32位整数，因此这里的int相当于VBA中的Long

它应该可以获得你想要的东西，但是按位运算符不是你想要的。

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))。

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

0 01111111 00000000000000000000000

1 10000000 11111111111111111111111

1 10000000 00000000000000000000000

4 个答案: