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

3 回答

• 1

  我想我已经找到了这样做的方法 . 以下函数 DoubleToBin 返回64位的字符串，表示IEEE-754双浮点数 . 它使用VBA "trick"来传递原始数据而不使用API例程（例如MemCopy（RtlMoveMemory）），将 LSet 与相同大小的用户定义类型组合在一起 . 一旦我们有了位串，我们就可以从中提取所有组件 .

  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
  

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

  回复于 2024-06-02T14:17:23+08:00
• 0

  这是对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中浮点数的优秀文章中的示例不同 . 两个版本都是10.4（到很多很多地方） . 我不太清楚该怎么做的差异 .

  回复于 2024-06-02T14:17:23+08:00
• 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 ）

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

  回复于 2024-06-02T14:17:23+08:00