Binär, Dual, Dezimal oder Decimal

.. das wohl mächtigste Werkzeug in Bill Gates' Büro-Sippe. Ob reine Formeln, PowerQuery oder VBA. Hier bleiben kaum Wünsche unerfüllt.
Benutzeravatar
d'r Bastler
Beiträge: 832
Registriert: 29. Aug 2022, 13:20
Hat sich bedankt: 224 Mal
Danksagung erhalten: 119 Mal

Binär, Dual, Dezimal oder Decimal

#1

Beitrag von d'r Bastler »

Moin allerseits,

als kleine Übung zum Code-Finetuning habe ich mir eine alte spaßige Aufgabe aus der XL-Welt genommen: Ich breche das Limit der XL-Formeln =BININDEZ und =DEZINBIN auf 8 Bit (das gibt es tatsächlich!) und löse per 50 Zeilen VBA:

Code: Alles auswählen

Option Explicit

Sub Bin2Dez()
Dim i As Integer, iBin As Single, iDez As Long, iLen As Long
Dim sBin As String

sBin = InputBox("Eingabe Binär")
If sBin = "" Then GoTo x

iBin = 0.5
For i = Len(sBin) To 1 Step -1
    iBin = iBin * 2
    If Mid(sBin, i, 1) <> "0" Then
        iDez = iDez + iBin
    End If
Next i
    
    iLen = Len(sBin)
    MsgBox "... wird " & iDez, , "Aus " & iLen & "-stellig " & sBin & " ..."
x:
End Sub

Sub Dez2Bin()
Dim iNum As Long, iBin As Long, iLen As Long
Dim sBin As String, sDez As String

On Error GoTo 0
iNum = CLng(InputBox("Eingabe Dezimal"))
sDez = iNum

iBin = 1
Do Until iBin > iNum
    iBin = iBin * 2
Loop

iBin = iBin / 2
Do Until iBin < 1
    If iNum >= iBin Then
            iNum = iNum - iBin
            sBin = sBin & "1"
        Else
            sBin = sBin & "0"
    End If
    iBin = iBin / 2
Loop

    iLen = Len(sBin)
    MsgBox "... wird " & iLen & "-stellig " & sBin, , "Aus " & sDez & " ..."
End Sub
Viel Spaß damit!
d'r Bastler von den VBAsteleien.de
Win 10 + Office 2019 & Win11 + Office 2021 + Visio 2019 pro & macOS.X15 + Office2019pro & Android12 & XL365
xlKing
Beiträge: 52
Registriert: 30. Mai 2024, 19:42
Hat sich bedankt: 5 Mal
Danksagung erhalten: 52 Mal
Kontaktdaten:

Re: Binär, Dual, Dezimal oder Decimal

#2

Beitrag von xlKing »

Hi Bastler

Das ist ja lustig, mit dem Problem hab ich mich seinerzeit auch schon rumgeschlagen. Ich habe das damals auf 14 Zeilen Code bekommen. Allerdings mit führenden Nullen. für Ln kann man im zweiten Parameter eine beliebige Länge zwischen 1 + 31 angeben da das Ganze im Beispiel auf den Datentyp Long begrenzt ist.

Code: Alles auswählen

Function Dec2BinLongNew(v As Long, Optional Ln As Byte = 31) As String
  Dim i As Long
  For i = Ln - 1 To 0 Step -1
    Dec2BinLongNew = Dec2BinLongNew & IIf(v And 2 ^ i, 1, 0)
  Next i
End Function
Function Bin2DecLongNew(ByVal s As String) As Long
  Dim i As Long
  If Len(s) > 31 Then Exit Function
  s = StrReverse(s)
  For i = 1 To Len(s)
    If Mid(s, i, 1) = "1" Then Bin2DecLongNew = Bin2DecLongNew + 2 ^ (i - 1)
  Next i
End Function
Gruß Mr. K.
Folgende Benutzer bedankten sich beim Autor xlKing für den Beitrag:
d'r Bastler
knobbi38
Beiträge: 25
Registriert: 20. Okt 2024, 14:15
Hat sich bedankt: 2 Mal
Danksagung erhalten: 19 Mal
Kontaktdaten:

Re: Binär, Dual, Dezimal oder Decimal

#3

Beitrag von knobbi38 »

Hallo,

hier mal eine auf Geschwindigkeit getrimmte Variante, welche korrekt mit allen 32Bit umgehen kann und dessen Laufzeit unabhängig von der Bit-Länge ist:

Code: Alles auswählen

Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" ( _
    dst As Any, src As Any, ByVal nBytes As Long)
    
Public Function Bin2Dez(ByVal BinValue As String) As Long
  If Len(BinValue) > 32 Then
    Error 5
  Else
    Bin2Dez = BitToLong04(Right$(String$(32, "0") & BinValue, 32))
  End If
End Function
    
Private Function BitToLong04(bitexpr As String) As Long
' by G.Beckmann, G.Beckmann@NikoCity.de, 20001230
' based on BitToLong03 by Egbert Nierop, egbert_nierop@goovy.hotmail.com, 20001228
' Source: http://www.xbeat.net/vbspeed/c_BitToLong.htm#BitToLong04
  Static t%(31): Dim asc0%
  
  If Len(bitexpr) <> 32 Then Exit Function
  
  RtlMoveMemory t(0), ByVal StrPtr(bitexpr), 64
  asc0 = KeyCodeConstants.vbKey0
  
  BitToLong04 = t(1) - asc0
  BitToLong04 = 2 * BitToLong04 + t(2) - asc0
  BitToLong04 = 2 * BitToLong04 + t(3) - asc0
  BitToLong04 = 2 * BitToLong04 + t(4) - asc0
  BitToLong04 = 2 * BitToLong04 + t(5) - asc0
  BitToLong04 = 2 * BitToLong04 + t(6) - asc0
  BitToLong04 = 2 * BitToLong04 + t(7) - asc0
  BitToLong04 = 2 * BitToLong04 + t(8) - asc0
  BitToLong04 = 2 * BitToLong04 + t(9) - asc0
  BitToLong04 = 2 * BitToLong04 + t(10) - asc0
  BitToLong04 = 2 * BitToLong04 + t(11) - asc0
  BitToLong04 = 2 * BitToLong04 + t(12) - asc0
  BitToLong04 = 2 * BitToLong04 + t(13) - asc0
  BitToLong04 = 2 * BitToLong04 + t(14) - asc0
  BitToLong04 = 2 * BitToLong04 + t(15) - asc0
  BitToLong04 = 2 * BitToLong04 + t(16) - asc0
  BitToLong04 = 2 * BitToLong04 + t(17) - asc0
  BitToLong04 = 2 * BitToLong04 + t(18) - asc0
  BitToLong04 = 2 * BitToLong04 + t(19) - asc0
  BitToLong04 = 2 * BitToLong04 + t(20) - asc0
  BitToLong04 = 2 * BitToLong04 + t(21) - asc0
  BitToLong04 = 2 * BitToLong04 + t(22) - asc0
  BitToLong04 = 2 * BitToLong04 + t(23) - asc0
  BitToLong04 = 2 * BitToLong04 + t(24) - asc0
  BitToLong04 = 2 * BitToLong04 + t(25) - asc0
  BitToLong04 = 2 * BitToLong04 + t(26) - asc0
  BitToLong04 = 2 * BitToLong04 + t(27) - asc0
  BitToLong04 = 2 * BitToLong04 + t(28) - asc0
  BitToLong04 = 2 * BitToLong04 + t(29) - asc0
  BitToLong04 = 2 * BitToLong04 + t(30) - asc0
  BitToLong04 = t(31) - asc0 + 2 * BitToLong04
  If t(0) <> asc0 Then BitToLong04 = BitToLong04 Or &H80000000
End Function
Kleiner Hinweis am Rande:
"Dim t%(31)" ist die Kurzschreibweise mit dem VBA Typkennzeichen % für Integer, ausgeschrieben wäre das dann:

Code: Alles auswählen

Dim t(31) as Integer
Gruß
Knobbi38
Folgende Benutzer bedankten sich beim Autor knobbi38 für den Beitrag (Insgesamt 2):
Paul1206, d'r Bastler
knobbi38
Beiträge: 25
Registriert: 20. Okt 2024, 14:15
Hat sich bedankt: 2 Mal
Danksagung erhalten: 19 Mal
Kontaktdaten:

Re: Binär, Dual, Dezimal oder Decimal

#4

Beitrag von knobbi38 »

Und hier das Gegenstück:

Code: Alles auswählen

Public Function DezToBin(ByVal Value As Long) As String
  DezToBin = LongToBit07(Value)
End Function

Public Static Function LongToBit07(l As Long) As String
' by Peter Nierop, pnierop.pnc@inter.nl.net, 20001226
' Source: http://www.xbeat.net/vbspeed/c_LongToBit.htm
  Dim lDone&, sNibble(0 To 15) As String, sByte(0 To 255) As String
  If lDone = 0 Then
    sNibble(0) = "0000 "
    sNibble(1) = "0001 "
    sNibble(2) = "0010 "
    sNibble(3) = "0011 "
    sNibble(4) = "0100 "
    sNibble(5) = "0101 "
    sNibble(6) = "0110 "
    sNibble(7) = "0111 "
    sNibble(8) = "1000 "
    sNibble(9) = "1001 "
    sNibble(10) = "1010 "
    sNibble(11) = "1011 "
    sNibble(12) = "1100 "
    sNibble(13) = "1101 "
    sNibble(14) = "1110 "
    sNibble(15) = "1111 "
    For lDone = 0 To 255
      sByte(lDone) = sNibble(lDone \ &H10) & sNibble(lDone And &HF)
    Next
  End If

  If l < 0 Then
    LongToBit07 = sByte(128 + (l And &H7FFFFFFF) \ &H1000000 And &HFF) _
                & sByte((l And &H7FFFFFFF) \ &H10000 And &HFF) _
                & sByte((l And &H7FFFFFFF) \ &H100 And &HFF) _
                & sByte(l And &HFF)
  Else
    LongToBit07 = sByte(l \ &H1000000 And &HFF) _
                & sByte(l \ &H10000 And &HFF) _
                & sByte(l \ &H100 And &HFF) _
                & sByte(l And &HFF)
  End If

End Function
Gruß
Knobbi38
Folgende Benutzer bedankten sich beim Autor knobbi38 für den Beitrag (Insgesamt 2):
Paul1206, d'r Bastler
Benutzeravatar
d'r Bastler
Beiträge: 832
Registriert: 29. Aug 2022, 13:20
Hat sich bedankt: 224 Mal
Danksagung erhalten: 119 Mal

Re: Binär, Dual, Dezimal oder Decimal

#5

Beitrag von d'r Bastler »

Moin liebe Kollegen,

immerhin die letzte Zeile meines Posts hat sich erfüllt: Auch Ihr hattet Spaß damit ;) Ich bin schwer beeindruckt, wie viele Workarounds da zu einem Xl-Limit möglich sind.

Zu knobbis freundlicher Übersetzung t% = t as integer (eine Codierung, die ich boshaft Eliten-Steno 8-) nenne) noch der Vollständigkeit halber:
$ = String, # = Double, ! = Single und & = Long
Falls noch mehr Steno gibt, gerne hier anfügen!

Schönen Tach!
d'r Bastler von den VBAsteleien.de
Win 10 + Office 2019 & Win11 + Office 2021 + Visio 2019 pro & macOS.X15 + Office2019pro & Android12 & XL365
knobbi38
Beiträge: 25
Registriert: 20. Okt 2024, 14:15
Hat sich bedankt: 2 Mal
Danksagung erhalten: 19 Mal
Kontaktdaten:

Re: Binär, Dual, Dezimal oder Decimal

#6

Beitrag von knobbi38 »

Hallo,

weitere Typkennzeichen:
  • & - Long
  • ^ - LongLong
  • @ - Currency

Byte, Boolean, Decimal, LongPtr, Variant und Object haben keine speziellen Typkennzeichen.

Date hat kein spezielles Typkennzeichen, kann aber als Datumsliteral in # eingeschlossen geschrieben werden,
z.B. #12/01/2024#, #2024-12-01#, #Dec 1 2024# ff.

Zitat aus der Doku:
"Gültige Formate beinhalten das Datumsformat, das in der Ländereinstellung für Ihren Code oder im universellen Datumsformat angegeben ist."
wobei ich das amerikanische Format MM/DD/YYYY oder das ISO-Format YYYY-MM-DD empfehlen würde. Im Direktfenster läßt sich das mit dem Datum #12/1/2024# sehr gut testen, was jeweils als Tag und Monat auf dem System interpretiert wird.


Gruß
Knobbi38

Nachtrag:
Natürlich lassen sich mit dem Literal # auch Zeitangaben angeben. Dafür wird als Trennzeichen der Doppelpunkt verwendet:
#12/01/2024 14:01:02#
Folgende Benutzer bedankten sich beim Autor knobbi38 für den Beitrag:
d'r Bastler
Antworten

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 0 Gäste