Binaire vers hexadecimal

Bonjour,

Afin de faciliter mon travail, j'aimerai trouver la solution Excel ou VBA afin de pouvoir convertir des valeurs BINAIRE en valeurs HEXA en AUTOMATIQUE.

J'ai joint un tableau pour ce faire: "bin2hexa". En colonne W mes valeurs BIN, en colonne Y la formule Excel de conversion en HEXA (pas de résultat), en colonne D les résultats que je devrais avoir (conversion manuelle). Dans la colonne W, c'est en format de cellule avec @ car sinon j'ai des chiffres scientifiques "Exp" que je ne souhaite pas dans mon tableau.

Mon Excel de travail avec VBA est celui: "draft-avec-listbox1"

La conversion BIN -> HEXA se fait en prenant le sens de lecture de droite a gauche en convertissant 4 bits a chaque fois

Ex: 0011 1011 0010 1000 = 3B28

En VBA, j'ai trouve cette fonction:

Function BinToHex(Binary As String)
Dim Value&, i&, Base#: Base = 1
For i = Len(Binary) To 1 Step -1
Value = Value + IIf(Mid(Binary, i, 1) = "1", Base, 0)
Base = Base * 2
Next i
BinToHex = Hex(Value)
End Function

Pouvez-vous m'aider ?

@+

bonjour Benji77,

et avec cette fonction ?

Function BinVersHexa(Bin As String)
     s0 = Replace(WorksheetFunction.Rept("0", 8) & Bin, " ", "") 'supprimer les espaces
     For i = Len(s0) - 3 To 5 Step -4 'traiter 4 bits par fois
          s1 = WorksheetFunction.Bin2Hex(Mid(s0, i, 4)) & s1 'remplacer 4 bits par leur valeur HEXA et ajouter en face
'Debug.Print s0, i, Mid(s0, i, 4), s1
     Next
     BinVersHexa = Mid(s1, IIf(Left(s1, 1) = "0" And Len(s1) > 1, 2, 1)) 'supprimer le zéro en face en cas de ...
End Function

bonjour,

hallo Bart !

une correction (mauvais format de colonne)

ok j'ai reussi ... a mettre la formule.

Mais sur mon formulaire quand je crée une nouvelle ligne et que j'apporte les modification BINAIRE dans la comboBox 23, il n'y a pas de conversion automatique en HEXA dans la comboBox 25, comment faire pour que la formule s'applique a chaque creation de ligne ?

A+

j'ai applique ceci pour mettre a jour:

Private Sub ComboBox25_Change()
Call BinVersHexa
End Function

ou ceci:

Private Sub UserForm_Initialize()
Dim j As Byte
Dim d
Dim i As Long

SortData_1

nomtableau = "Tableau1"
nbcol = Range(nomtableau).ListObject.ListColumns.Count
TblBD = Range(nomtableau).Resize(, nbcol + 1).Value

For j = 1 To 2
    Set d = CreateObject("scripting.dictionary")
    d.CompareMode = vbTextCompare
    For i = LBound(TblBD) To UBound(TblBD)
        d(TblBD(i, j + 4)) = vbNullString
    Next i
    Me.Controls("ChoixListBox" & j).List = liste_triée_sans_doublons(d.keys)
Next j

For j = 3 To 16
    Set d = CreateObject("scripting.dictionary")
    d.CompareMode = vbTextCompare
    For i = LBound(TblBD) To UBound(TblBD)
        d(TblBD(i, j + 7)) = vbNullString
    Next i
    Me.Controls("ChoixListBox" & j).List = liste_triée_sans_doublons(d.keys)
Next j

For j = 1 To 30
    Set d = CreateObject("scripting.dictionary")
    d.CompareMode = vbTextCompare
    For i = LBound(TblBD) To UBound(TblBD)
        Select Case j
            Case 27, 28, 29, 30: d(TblBD(i, j - 26)) = vbNullString
            Case Else: d(TblBD(i, j)) = vbNullString
        End Select
    Next i
    Me.Controls("ComboBox" & j).List = liste_triée_sans_doublons(d.keys)

Next j

With Me.ListBox20
    .ColumnCount = 31 'à par nbcol sir c'est tout le tableau qui est à prendre dans la listbox
    .List = TblBD
    .ColumnWidths = "75;200;75;75;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0"

End With
Call BinVersHexa
End Sub

Message d'erreur :

a+

Bonjour h2so4,

J'arrive pas a ouvrir votre formulaire.

a+

h2so4,

J'ai réussi a ouvrir votre formulaire, c'est la valeur affichée dans la dernière ligne de la colonne 25 qui faisait bugger l'ouverture.

Par contre au dela de 32 bits il ne fait plus de conversion, alors qu'il faudrait qu il aille au dela de 32 bits.

a+

J'ai cette formule a placer en macro pour recopier la formule d'une colonne de la premiere ligne jusqu' a la dernière:

Sachant qu a chaque incrementation avec bouton 5 ou 14 un ID se cree en colonne A

Sub Extension_formule()
Dim DernLigne As Long
Range("Y3").Copy
Range("Y4:Y" & Range("A" & Rows.Count).End(xlUp).Row).PasteSpecial
End Sub

J'ai mis cette formule mais il ne se passe rien dans la conversion en HEXA quand une nouvelle ligne ou un nouveau mode est cree, de meme quand je modifie une ligne avec la formule censee est presente, pas de conversion non plus, la formule est enlevee.

Un conseil ?

A+

peu etre :

Sub Extension_formule()
Dim DernLigne As Long

DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Range("Y3").AutoFill Destination:=Range("Y3:Y" & DernLigne)
End Sub

Sub Macro1()
Dim LastRw As Long
LastRw = Sheets("DATABASE_VUSHF").Cells(Rows.Count, 1).End(xlUp).Row
Range("Y3:Y" & LastRw).FillDown
End Sub

je n'y arrive pas les codes VBA, une aide ? SVP

A+

C'est bon j'ai trouve, tout fonctionne !!!!!!!!

Merci encore !!!!!!

a+