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:
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
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.
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:
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:
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):
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 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
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: