VBA decimaal naar binair converter

[kingzpwn]

Ik heb een probleem met mijn code. Kunt u me alsjeblieft helpen. Hier is mijn code:

Dim i, Power, Number, DecNum As Integer
Dim Digit As Single


Private Sub bin2dec_Click()
txtDec.Text = ""
Power = Len(txtBin.Text)
Number = Val(txtBin.Text)
For i = 0 To Len(txtBin.Text) - 1
DecNum = DecNum + Right(Number, 1) * 2 ^ i
Number = Left(Number, Len(Number) - 1)
Next i
txtDec.Text = DecNum
DecNum = 0
End Sub



Private Sub Dec2Bin_Click()

Number = Val(txtDec.Text)

Do While Number >= 2
Num = Num & Number Mod 2
Number = Int(Number / 2)
If Number = 1 Then
Num = Num & 1
ElseIf Number = 0 Then
Num = Num & 0
End If
Loop
For i = 0 To Len(Num) - 1
Binary = Right(Num, 1) & Binary
Num = Left(Num, Len(Num) - 1)
Next i
If Len(Binary) <= 8 Then
txtBin.Text = Format(Binary, "00000000")
ElseIf Len(Binary) > 8 Then
txtBin.Text = Format(Binary, "00000000 00000000")
End If
End Sub

Alvast bedankt!:d

De code doet het niet, je krijgt helemaal andere getallen dan er moet.
Weet u misschien hoe het beter moet ??

 

[edmoor]

Misschien handig om er ook bij te vertellen wat je probleem is.
Wil je misschien ook even je code in codetags zetten?
Nu zijn de inspringpunten weg gevallen.

 

[wampier]

En misschien minder relevant, maar wat is er mis met de ingebouwde functie?

 

[kingzpwn]

ik heb het aangepast, bedankt voor u tijd.

 

[Mark xl]

Als je over Excel 2010 beschikt, kun je gebruikmaken van

Debug.print worksheetfunction.Dec2Bin(254)

Je kunt ook in eerdere versies van excel het analysis toolpack inschakelen, maar ik zou nooit macros schrijven die afhankelijk zijn van op de client geactiveerde toepassingen, dan kom je achteraf voor nare verrassingen te staan. (bovendien weet ik niet eens of je Excel gebruikt)

deze forumpost op ozgrid staat een mooi algoritme op (binary = base 2).

 

[kingzpwn]

Maar het probleem is dat ik alleen VBA kan gebruiken. Dus ik kan het niet maken zonder macro's. Is het mogelijk om het in VBA te maken?

 

[Mark xl]

Natuurlijk, zie die forumpost

Je kunt natuurlijk ook creatief zijn en eerst naar octaal converteren en dan een matrix voorprogrammeren.
das een stuk makkelijker te bevatten ook

'eenvoudige dec naar bin converteerder.
'   kan ongetwijfeld veel sneller/beter/efficienter
Function cBin(n As Long) As String
    'nul = "0"
    If n = 0 Then cBin = "0": Exit Function
    
    Static Oct2Bin As Variant 'voorgedefinieerde oct 2 bin conversie
    Dim strOct As String        'bevat straks octale getalstring
    Dim i As Long
    Dim result As String        'functie resultaat
    
    If IsEmpty(Oct2Bin) Then Oct2Bin = Array("000", "001", "010", "011", "100", "101", "110", "111")
    'converteren getal naar octale string
    strOct = Oct(CLng(n))
    
    For i = 1 To Len(strOct)
        'uitlezen voorgedefinieerde oct 2 bin array
        result = result & Oct2Bin(Mid(strOct, i, 1))
    Next
    
    'voorloopnullen weghalen
    cBin = Mid(result, InStr(result, 1))
    
End Function

en testen

'testen!
Sub test()

    Dim i As Long

    For i = 0 To 255
        Debug.Print i & vbTab & cBin(i)
    Next
    
End Sub

 

[kingzpwn]

maar de functie werkt niet op VBA

 

[Mark xl]

Definieer "VBA"

 

[snb]

in VBA:

Sub snb()
    MsgBox cbin(256)
End Sub

Function cbin(x)
    For j = 20 To 0 Step -1
        cbin = cbin & x \ (2 ^ j)
        x = x Mod (2 ^ j)
    Next
    cbin = Val(cbin)
End Function