Hexavigesimal (base26)

Soyez le premier à donner votre avis sur cette source.

Snippet vu 5 483 fois - Téléchargée 24 fois

Contenu du snippet

En fait pas le Base 26 comme on l'entend mais plutot tel qu'il est appliqué sur les Feuille Excel
cad A = 1 : Z = 26 : AA = 27

Il y a deux fonctions:
une premiere DecToB26 qui a un gros probleme avec le Z .... (la je suis dans l'impasse)
.... si un deux vous a la solution..
une deuxieme B26ToDec qui semble marcher correctement

Source / Exemple :


Private Const Chaine26 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

    'Decimal vers Hexavigesimal windows
    Function DecToB26(ByVal Value As String) As String
        If Not IsNumeric(Value) Then Return Value
        Dim v1 As Long
        Dim Resultat As String = ""
        Do While (Value > 0)
            v1 = (Value Mod 26)
            Value = Int(Value / 26)
            Resultat = Mid$(Chaine26, 0 + v1, 1) & Resultat
        Loop
        Return Resultat
    End Function

    'Hexavigesimal windows vers Decimal   
    Function B26ToDec(ByVal MyString As String) As Decimal
        If IsNumeric(MyString) Then Return MyString 
        Dim v2 As Decimal
        Dim i As Integer
        Dim j As Byte
        Dim Resultat As Decimal
        'Virer les Espaces
        Dim MyString2 As String = MyString.Replace(" ", "").ToUpper
        For i = Len(MyString2) To 1 Step -1
            v2 = InStr(1, Chaine26, Mid$(MyString2, i, 1))
            If v2 < 1 Then Return Resultat
            If v2 >= 27 Then Return Resultat
            For j = 1 To (Len(MyString2) - i)
                v2 = v2 * 26
            Next
            Resultat = Resultat + v2
        Next
        Return Resultat
    End Function

Conclusion :


il s'agit d'une transformation d'un code trouvé sur codyx et adapté

A voir également

Ajouter un commentaire

Commentaires

Messages postés
32
Date d'inscription
dimanche 15 juin 2003
Statut
Membre
Dernière intervention
17 janvier 2007

Si c'est pour optimiser la vitesse, essaye une fois (j'ai enlevé la conversion string->long et long->string à chaque itération):

Function DecToB26(ByVal Value As String) As String
If Not IsNumeric(Value) Then Return Value
Dim v1 As Long
Dim Resultat As String = ""
v1=int(Value)
Do While v1 > 0
Resultat = chr$((Value Mod 26)+65) & Resultat
v1 = clng(v1 / 26)
Loop
Return Resultat
End Function
Messages postés
13
Date d'inscription
mardi 30 décembre 2003
Statut
Membre
Dernière intervention
18 juin 2008

Merci .. vérifié, ce n'est pas flagrant mais sur une boucle test de 2M j'obtient 49s avec constante et 44s avec chr asc

par contre juste une petite modi a ton code pour que ca marche:

Resultat = Mid$(Chaine26, 0 + v1, 1) & Resultat
devient Resultat = chr$(v1+65) & Resultat

v2 = InStr(1, Chaine26, Mid$(MyString2, i, 1))
devient v2 = asc(Mid$(MyString2, i, 1)))-64

sinon j'ai viré les $ .... faute d'euros je prefere rien mettre ;)
Messages postés
32
Date d'inscription
dimanche 15 juin 2003
Statut
Membre
Dernière intervention
17 janvier 2007

Au lieu de mettre une chaine string en constante, utilise les fonctions asc et chr, en sachant que "A"=chr(65), "B"=chr(66) etc, ce sera plus rapide:

Resultat = Mid$(Chaine26, 0 + v1, 1) & Resultat
devient Resultat = chr$(v1+65) & Resultat

v2 = InStr(1, Chaine26, Mid$(MyString2, i, 1))
devient v2 = asc(Mid$(MyString2, i, 1)))-65

Cela devrait marcher, sans l'avoir testé!
Messages postés
13
Date d'inscription
mardi 30 décembre 2003
Statut
Membre
Dernière intervention
18 juin 2008

Et bien..... MERCI!!
ca marche impec (je vien de tester avec une boucle sur 100000 et pas d'erreur.

je desesperai depuis deux jours:)

encore merci
Messages postés
1263
Date d'inscription
mardi 11 novembre 2003
Statut
Membre
Dernière intervention
24 juillet 2013
6
Essaie ceci

'Decimal vers Hexavigesimal windows
Function DecToB26(ByVal Value As String) As String
If Not IsNumeric(Value) Then Return Value
Value = Value -1
Dim v1 As Long
Dim Resultat As String = ""
Do While (Value >= 0)
v1 = (Value Mod 26)
Value = Int(Value / 26) - 1
Resultat = Mid$(Chaine26, v1 + 1, 1) & Resultat
Loop
Return Resultat
End Function

Cela fonctionne correctement chez moi
A+

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.