Question

我有一个数字（比如5），我首先要将其转换为二进制（101），然后在VBA中分成一个位{1,0,1}或布尔{True,False,True}的数组

有没有办法在没有循环的情况下执行此操作？

我可以使用工作表公式转换为Binary，而无需在我的代码中循环，如下所示

myBinaryNum = [DEC2BIN(myDecInteger,[places])]

但我被告知工作表功能非常低效，而且这个功能特别有限。

我不确定如何在不使用MID循环数字的情况下拆分成数组。数字有strConv吗？

Answer 1

您可以先将值转换为＆＃34; 01＆＃34;带有WorksheetFunction.Dec2Bin的字符串。然后更换每个＆＃34; 0＆＃34;，＆＃34; 1＆＃34;使用代码0或1并将结果转换为Byte数组：

Public Function ToBitArray(ByVal value As Long) As Byte()
  Dim str As String
  str = WorksheetFunction.Dec2Bin(value)                   ' "101"
  str = Replace(Replace(str, "0", ChrW(0)), "1", ChrW(1))  ' "\u0001\u0000\u0001"
  ToBitArray = StrConv(str, vbFromUnicode)                 ' [1, 0, 1]
End Function

但Dec2Bin仅限于511，使用字符串相当昂贵。因此，如果您的目标是获得最佳性能，那么您应该使用循环来读取每个位：

Public Function ToBitArray(ByVal value As Long) As Byte()
  Dim arr(0 To 31) As Byte, i As Long
  i = 32&

  Do While value
    i = i - 1
    arr(i) = value And 1
    value = value \ 2
  Loop

  ToBitArray = MidB(arr, i + 1)   ' trim leading zeros
End Function

Answer 2

我在SO的另一个问题here上找到了这个简洁的代码。基本上，你可以确定你的字符串是ASCII，因为它是1和0的。

你做的是使用

Dim my_string As String

my_string =  CStr("your binary number")

将二进制数转换为字符串

然后

Dim buff() As String
buff = Split(StrConv(my_string, vbUnicode), Chr$(0))
ReDim Preserve buff(UBound(buff) - 1

将该字符串拆分为数组，其中buff是您的数组

Answer 3

我想你可能从其他答案中得到了你需要的一切，但是如果你想要一个带小数的简单函数并返回数组......

Function dec_to_binary_array(decNum As Integer)
    Dim arr() As String, NumAsString As String
    NumAsString = Application.Dec2Bin(decNum)
    arr = Split(StrConv(NumAsString, vbUnicode), vbNullChar)
    ReDim Preserve arr(UBound(arr) - 1)
    dec_to_binary_array = arr
End Function

Answer 4

调用Application.Dec2Bin(n)并不是非常昂贵的，它只需要一个后期绑定调用。使用下面的函数将任何整数转换为位数组：

Function Bits(n as long)
  Dim s As String: s = Application.Dec2Bin(n)
  Dim ar: ar = Split(StrConv(s, vbUnicode), vbNullChar)
  Bits = ar
End Function

p.s。：s只包含0和1这些ASCII字符，因此拆分技术完全有效。

Answer 5

Function d2bin(dec As Integer, bits As Integer) As Integer()
    Dim maxVal As Integer
    maxVal = 2 ^ (bits)-1

    If dec > maxVal Then Exit Function

    Dim i As Integer
    Dim result() As Integer
    ReDim result(0 To bits - 1)

    For i = bits - 1 To 0 Step -1
        result(bits - i - 1) = -(dec > (2 ^ (i) - 1))
        If result(bits - i - 1) Then dec = dec - (2 ^ i)
    Next i

    d2bin = result

End Function

Answer 6

如果您需要，请检查此代码：您可以用任何单元格值引用替换数字5，这只是示例：

Sub dectobinary()
Dim BinaryString As String

BinaryString = "5"

tempval = Dec2Bin(BinaryString)

MsgBox tempval

End Sub


Function Dec2Bin(ByVal DecimalIn As Variant) As String
Dec2Bin = ""
DecimalIn = Int(CDec(DecimalIn))
Do While DecimalIn <> 0
    Dec2BinTemp = Format$(DecimalIn - 2 * Int(DecimalIn / 2))
        If Dec2BinTemp = "1" Then
            Dec2Bin = "True" & "," & Dec2Bin
        Else
            Dec2Bin = "False" & "," & Dec2Bin
        End If
    DecimalIn = Int(DecimalIn / 2)
Loop
End Function

Answer 7

只需将lngNumber值更改为您想要的数字

Public Sub sChangeNumberToBinaryArray()

Dim strBinaryNumber As String
Dim strBinaryArray()  As String
Dim lngNumber As Long

    lngNumber = 5

    strBinaryNumber = DecToBin(lngNumber)
    strBinaryArray() = Split(strBinaryNumber, "|")

End Sub

函数DecToBin（ByVal varDecimalIn As Variant）As String

Dim lngCounter As Long

    DecToBin = ""
    varDecimalIn = Int(CDec(varDecimalIn))
    lngCounter = 1
    Do While varDecimalIn <> 0
        If lngCounter = 1 Then
            DecToBin = Format$(varDecimalIn - 2 * Int(varDecimalIn / 2)) & DecToBin
            lngCounter = lngCounter + 1
        Else
            DecToBin = Format$(varDecimalIn - 2 * Int(varDecimalIn / 2)) & "|" & DecToBin
            lngCounter = lngCounter + 1
        End If
        varDecimalIn = Int(varDecimalIn / 2)
    Loop
End Function

没有循环的整数到布尔/位数组

7 个答案: