XL 2016 Checksum XOR d'une chaine alphanumérique

[decolit]

Bonjour à tous,

Je suis nouvel arrivant sur XLD et je n'ai pas trouvé de discussion ayant traité ou traitant du sujet ci-dessus dans le forum. Pardon par avance si ma recherche s'avérait imparfaite, mais je n'ai pas trouvé de réponse pertinente. Je ne sais pas écrire du code VBA mais je peux décrire mon besoin :
- soit une chaine alphanumérique constituée strictement de lettres majuscules et de chiffres de 1 à 9, les lettres "O", "I" et "Q" étant également exclues de l'alphabet autorisé contenant donc 32 caractères,
- soit une longueur de chaine comprise entre 7 et 10 caractères,
1. générer une série de chaines alphanumériques uniques (dédoublonnées, donc) respectant les critères ci-dessus dans une colonne d'une feuille excel, par exemple 100, 500 ou 1000 codes
2. calculer le checksum Xor (bit à bit) de chaque chaine, et convertir le résultat en hexadécimal
3. dans la colonne adjacente à la colonne contenant les chaines, concaténer chaque chaine avec le XOR converti en hexadécimal calculé

je pense être en mesure de bricoler une formule sur excel avec code() pour extraire la valeur ASCII de chaque caractère de la chaine, puis d'utiliser un bitouexclusif() qui remplace l'opérateur XOR qui lui est natif sous VBA que je ne sais pas utiliser. Je suis persuadé qu'il est possible d'automatiser de façon élégante un tel processus sous VBA, mais j'en suis incapable.

Pouvez-vous m'aider ? Et je renouvelle mes excuses si je ne suis pas dans le bon schéma de demande ou de discussion ou si je ne suis pas parvenu à trouver ce que je cherchais dans l'historique.

Meci pour votre retour

 

[sylvanu]

Bonsoir Decolit,
Un essai pour vous lancer en PJ.
Le code est simple et peut être facilement bidouillé.

Nombre de chaines comprises entre 500 et 1500 avant dédoublonnage.
Nb=nombre caractères compris entre 7 et 10.

 

[decolit]

Bonjour Sylvanu,
Merci beaucoup pour ce retour. Les fonctions répondent pour l'essentiel à ce que je cherche, bravo !!
Le nombre de codes à générer ne doit pas être aléatoire mais choisi, idem pour la longueur des chaines (le nombre de caractères). Je vais essayer de comprendre et d'utiliser la partie de code concernant le calcul du chksum Xor et la concaténation pour l'appliquer à un classeur où sont générés les chaines dédoublonnées, mais je ne connais absolument rien à VBA.
Bravo et merci encore.

 

[sylvanu]

Bonjour,
C'est encore plus simple si l'utilisateur fixe le nombre de chaines et le nombre de caractères.
( comme la méthode de dédoublonnage ne permet pas de connaitre le nombre final de chaines, j'en calcule 2000, les dédoublonne et efface les inutiles )
C'est peut être faisable uniquement dans les cellules, mais je n'aime pas les formules à rallonge.
Une bonne occasion de s'initier au VBA. Attention, on peut devenir accro.

 

[decolit]

Bonjour,

C'est bien ce qui répond au problème, je vous remercie.
En premier, merci encore pour votre concours. J'ai essayé d'insérer votre code concernant le calcul du Chksum avec l'opérateur XOR, en bas du code ci-dessous que j'utilise pour tester cette génération de codes uniques. Mais ça ne marche pas avec un message d'erreur : argument incorrect ou quelque chose comme ça. Je ne maitrise ni la syntaxe VBA, ni la logique VBA. J'ai essayé de déclarer les variables le plus logiquement du monde pour moi, mais je ne comprends pas vraiment ce qui cloche.
Le code ci-dessous provient d'un contributeur ayant posté sur un autre forum un générateur excel de codes dédoublonnés et archivés, mais ne permettant pas de sélectionner le nombre de codes. Quoi qu'il en soit, je le remercie également. J'ai juste tenté d'appliquer le checksum selon votre propre code qui fonctionne très bien, mais que je ne sais pas écrire : j'ai ajouté la variable Chksum et les lignes de votre code en essayant de les adapter aux variables déclarées, mais...
Si vous pouviez m'expliquer ce qui cloche, je me sentirais un peu moins bête. Merci encore pour votre attention

Option Explicit
Const Plage = "A1:A50"
Const carac = "23456789ABCDEFGHJKLMNPRSTUVWXYZ"

Sub Aleatoire()
Dim xrg As Range, cel As Range, x
Dim op1, op2, tail, i&, max&, total&, prefix, dico, n&
Dim tablo, Ou As Range, col&
Dim Chksum As String

Set xrg = Range(Plage): total = xrg.Count
'on efface la plage
xrg.ClearContents: Application.ScreenUpdating = False
op1 = UCase([g1]): op2 = UCase([g2]): tail = UCase([g3])
max = Len(carac): prefix = op1 & op2
Set dico = CreateObject("scripting.dictionary")

With Sheets("Archive")
'recherche de la clef (op1 & op2 & tail)
On Error Resume Next
Set Ou = .Rows("1:1").Find(op1 & op2 & tail, .Range("a1"), xlValues, xlWhole)
On Error GoTo 0
If Ou Is Nothing Then

Set Ou = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1)
End If
Ou = op1 & op2 & tail

tablo = .Range(Ou, .Cells(.Rows.Count, Ou.Column).End(xlUp))

If IsArray(tablo) Then
For i = 2 To UBound(tablo): dico(tablo(i, 1)) = "": Next i
End If
total = total + dico.Count
End With
Randomize
Do
x = prefix
For i = 3 To tail
x = x & Mid(carac, 1 + (Int((Rnd * 1000000)) Mod max), 1)
Next i
dico(x) = ""
Loop Until dico.Count = total

On Error Resume Next
If IsArray(tablo) Then For i = 2 To UBound(tablo): dico.Remove tablo(i, 1): Next i
On Error GoTo 0
n = Sheets("Archive").Cells(Rows.Count, Ou.Column).End(xlUp).Row
For Each cel In xrg
x = dico.keys()(0): cel = x
n = n + 1: Sheets("Archive").Cells(n, Ou.Column) = x
dico.Remove x
Next cel
For Each cel In xrg
Chksum = 0
For i = 1 To max
Chksum = Chksum Xor Asc(Mid(x, i, 1))
Next i
Chksum = WorksheetFunction.Dec2Hex(Chksum)
xrg.Cells(i, 1) = xrg & Right("00" & Chksum, 2)
Next cel

End Sub

 

[sylvanu]

Bonjour,
De ces deux lignes une comporte une erreur. Devinez !

xrg.Cells(i, 1) = xrg & Right("00" & Chksum, 2)

xrg.Cells(i, 1) = xrg.Cells(i, 1) & Right("00" & Chksum, 2)

 

[decolit]

Bonjour Sylvanu,
Merci pour votre retour
c'est sans doute cette ligne qui st erronée :
xrg.Cells(i, 1) = xrg & Right("00" & Chksum, 2).
car la cellule (i,1) de la plage xrg n'est pas définie dans le résultat du traitement exprimé à droite du signe =. Est-ce que cette explication est correcte ?

 

[decolit]

Bonjour,

J'ai essayé de faire tourner le code, mais ça ne marche pas, il y a une "erreur d'exécution '5' : argument ou appel de procédure incorrect".

Lorsque je compare la syntaxe de votre code :
Chksum = WorksheetFunction.Dec2Hex(Chksum)
[ChainOut].Cells(i, 1) = Chaine & Right("00" & Chksum, 2)

avec l'écriture :
xrg.Cells(i, 1) = xrg & Right("00" & Chksum, 2)


je constate que vous n'avez pas écrit :
[ChainOut].Cells(i, 1) = Chaine.Cells(i, 1) & Right("00" & Chksum, 2)
mais bien
[ChainOut].Cells(i, 1) = Chaine & Right("00" & Chksum, 2)

Je ne peux pas vérifier l'erreur du code Cheksum intégré au code du fichier que j'utilise et je ne comprends pas la logique de la syntaxe.

 

[sylvanu]

Regardez mon code.
Je crée une variable Chaine que j'initialise à "", puis je la remplit de caractères.
Je calcule la checksum puis la concatère avec Chaine.

Vous, c'est différent, vous prenez une cellule puis vous ajoutez la checksum.
La méthode est différente donc la syntaxe est différente.

Je n'ai pas regardé ce que fait votre macro, mais intégrée dans un fichier chez moi elle ne génère pas d'erreur. Voir PJ.

 

[decolit]

Bonjour,
Merci pour votre retour, chez moi (excel2016) j'ai le message d'erreur : "argument ou appel de procédure incorrect".
Lorsque je clique sur débogage c'est la ligne ci-dessous qui est en surbrillance jaune :

Chksum = Chksum Xor Asc(Mid(x, i, 1))

 

[decolit]

à chaque changement de paramètre (op1, op2 et tail) le message d'erreur apparait et les chaines sont générées sans le checksum.

 

[sylvanu]

Je suis sous XL2007, donc la compatibilité étant ascendante, je ne vois pas où est le problème.

Remplacez votre ligne en défaut par :

'Chksum = Chksum Xor Asc(Mid(x, i, 1))
ValMid = Mid(x, i, 1)
ValAsc = Asc(ValMid)
Chksum = Chksum Xor ValAsc

on verra bien où ça coince.

Au fait, dans votre chaîne Carac le "1" manque. ( si def correcte en post #1 )

 

[decolit]

Bonjour Sylvanu,
Et merci encore pour tout ce que vous faites. Noté pour le caractère "1" mais cela ne me posera pas de problème particulier.
J'ai bien compris que ces lignes correspondent à la conversion de chaque caractère de la chaine en code ASCII, nécessaire à l'opération Xor pour obtenir le checksum
j'ai déclaré la variable ValMid en String, et la variable ValAsc en Integer (je ne sais pas si c'est correct)
Les chaines générées ne contiennent toujours pas le checksum Xsor à la fin. C'est facile à vérifier les 2 derniers caractères de certaines chaines contiennent des Z ou des R, ce qui impossible en hexadécimal. Ceci dit, le checksum n'est pas encore calculé au stade du plantage de la macro.
Le message d'erreur est le même sauf que la ligne qui plante est :
ValAsc = Asc(ValMid)

je suis désolé. Merci encore pour votre aide.

 

[decolit]

l'erreur vient peut-être de la variable x qui est mal utilisée pour représenter la chaine à Xoriser ?

 

[sylvanu]

Je ne vois pas.
ValMid = Mid(x, i, 1) Extrait de la chaine x le caractère de position i.
ValAsc = Asc(ValMid) Renvoie le code ASCII de ce caractère. ( sur 8 bits ).
Chksum = Chksum Xor ValAsc Fait le XOR entre ce code et la Chksum existante.

L'erreur vient peut être de ValMid en Integer ( 16 bits ) passez le en Byte ( 8 bits ), mais chez moi ça fait la même chose.

C'est en désespoir de cause. Faites le remplacement :

'Chksum = Chksum Xor Asc(Mid(x, i, 1))
ValMid = Mid(x, i, 1)
MsgBox ("ValMid = " & ValMid)
ValAsc = Asc(ValMid)
MsgBox ("ValAsc = " & ValAsc)
Chksum = Chksum Xor ValAsc

Une fenêtre vous donnera chaque valeur de ValMid et Valasc.
( pour soortir faites Echap et restez appuyé , c'est long )