XL 2019 VBA : Calcul checksum xor d'une chaine de longueur variable

[decolit]

Bonjour à tous,

Tout d'abord, je souhaite santé et réussite à tous pour 2021 !
J'ai essayé d'utiliser des fonctions d'excel type BITOUEXCLUSIF() pour calculer un checksum xor d'une chaine alphanumérique de longueur X (=X caractères), après avoir calculé la valeur ascii de chaque caractère au moyen de la fonction code(). Le checksum calculé doit être converti en hexadécimal.
Si le checksum hexadécimal ne comporte qu'un seul caractère, alors il faut "ajouter" un zéro avant le checksum, de sorte que tous les checksum aient une longueur de 2 digits.
Ca marche quand il y a quelques lignes, mais c'est beaucoup trop lourd et long quand le fichier comporte 100000 lignes.
Dans le tableur joint, je donne un exemple de ce que je souhaite faire :

- soit A la colonne contenant les chaines à checksumiser, il peut y avoir Y chaines à traiter
- soit B la colonne contenant le checksum xor de la chaine correspondante en colonne A
- une fois ce checksum calculé, j'ai besoin de concaténer la chaine avec le checksum correspondant dans la colonne C.
J'ai utilisé https://www.scadacore.com/tools/programming-calculators/online-checksum-calculator/ pour vérifier les checksum.
J'ai donc besoin d'encoder tout ça en VBA pour avoir un algorithme. Je suis proprement incapable de le faire car VBA est opaque pour moi, même si je sais qu'il existe la fonction xor.

Je vous remercie par avance pour votre aide.

 

[Dranreb]

Bonsoir et bonne année.
Cette fonction perso devrait vous convenir :

Function CheckSum(ByVal X As String) As String
   Dim S As Byte, P As Integer
   For P = 1 To Len(X)
      S = S Xor Asc(Mid$(X, P, 1))
      Next P
   CheckSum = Right$("0" & Hex$(S), 2)
   End Function

 

[decolit]

Bonsoir Dranreb,
Je vous remercie pour votre rapidité.
Je recopie le code dans un module du classeur test et vous fais un retour dans la foulée.
Encore merci.

 

[decolit]

Merci Dranreb,

Le calcul du chk est parfait, merci encore. J'essaie de comprendre ce que représente Mid$, je me doute que P est la position du caractère dans la chaine à xoriser, mais Mid$ ?

st-il possible d'étendre la fonction à toute la colonne et de concaténer chaine et chk, pour éviter de recopier la fonction quand il y a 20000, ou 100000 valeurs de chaines ?

Merci encore

 

[Dranreb]

Mid$ c'est la function qui justement extrait une sous chaine à partir de la position P. Le $ à la fin c'est pour qu'elle renvoie un String et non un Variant/String
Oui, il suffit de changer la dernière instruction :

   CheckSum = X & Right$("0" & Hex$(S), 2)

La fonction peut être invoquée dans une formule répétée à chaque ligne.
Où est le problème ? Si vous vouliez un code qui met plutôt les valeurs, ça impliquerait de définir à quel moment vous voulez que ça s'exécute.

 

[decolit]

Merci Dranreb, pour les explications sur la syntaxe et la fonction Mid$ (désolé, je suis incapable d'utiliser VBA et je ne suis pas familier de VABA).
Pas de problème, ma dernière question porte simplement sur la situation courante :
une série de 20000 ou 100000 chaines à xoriser comme votre code le permet, mais pour produire en une fois les chaines complétées avec le chk calculé en 1 fois.
Merci pour votre aide.

 

[decolit]

Merci à Dranreb,
Je considère que la question est résolue.

 

[soan]

Bonjour @decolit, Dranreb,

je te propose le fichier ci-dessous ; fais Ctrl e ➯ travail effectué !

important : si tu ajoutes d'autres données et que tu fais à nouveau Ctrl e,
ça fera ce qu'il faut : les résultats déjà obtenus avant seront inchangés.

d'après moi, le temps d'exécution sera très rapide, même sur de grandes
séries de 20 000 ou 100 000 chaînes à xoriser ou à vampiriser.
ah non, pardon, halloween est déjà passé.

alors bonne année 2021 quand même !

soan

 

[soan]

@decolit

si ma solution te convient, n'oublie pas de marquer comme solution ton prochain
post plutôt que mon post #8 : c'est tellement plus logique !

soan

 

[decolit]

Bonjour Soan,
Merci pour ton retour efficace. La routine est très rapide en effet. Mais le résultat "écrase" les chaines sources, et j'ai besoin de les conserver dans leur colonne d'origine, ici la colonne A.
A partir du code que tu as écrit, je ne sais pas comment spécifier que chaque chaine xorisée doit être écrite dans la cellule adjacente (donc en colonne B) à la cellule où se trouve la chaine source.
Je joins un fichier qui compile à la fois la fonction de dranreb (merci encore) et un sub qui permet d'xoriser les chaines dans une colonne adjacente :

Function Chkxor(ByVal X As String) As String
   Dim S As Byte, P As Integer
   For P = 1 To Len(X)
      S = S Xor Asc(Mid$(X, P, 1))
      Next P
   Chkxor = Right$("0" & Hex$(S), 2)
   End Function

Sub TestXor()
  Dim cell As Range, chk As Long, i As Long, str1 As String
    For Each cell In Range("A2:A1000")
    If Not IsEmpty(cell) Then
      str1 = cell.Value
    chk = Asc(Left$(str1, 1))
      For i = 2 To Len(str1)
          chk = chk Xor Asc(Mid$(str1, i, 1))
      Next i
      cell.Offset(, 2).Value = cell.Value & Right$("00" & Hex$(chk), 2)
      End If
  Next cell
End Sub

Ce que je n'ai pas su faire c'est trouver la bonne syntaxe pour exprimer que le calcul doit s'effectuer sur la plage A2:A, quel que soit le nombre de chaines à xoriser : il peut y en avoir 2 comme il peut y en avoir 200000. Mais VBA me retourne une message : plage non définie (ce qui est justement ce que je veux !!!).

Merci encore.

 

[decolit]

En déclarant la fonction Chkxor de dranreb, ce code très efficace de Phuocam (que je remercie) correspond à ce que je veux sans avoir à appeler Chkxor :

Sub CHAINXOR()
  Dim Arr As Variant,  i As Long,  lastRow As Long
  lastRow = Range("A" & Rows.Count).End(xlUp).Row
  Arr = Range("A2:A" & lastRow).Value
    For i = 1 To UBound(Arr)
        If Arr(i, 1) <> "" Then Arr(i, 1) = Arr(i, 1) & Chkxor(Arr(i, 1))
    Next i
  Range("C2").Resize(UBound(Arr), 1) = Arr
End Sub

Merci à vous tous.

 

[soan]

@decolit

tu as écrit : « Mais le résultat "écrase" les chaines sources, et j'ai besoin
de les conserver dans leur colonne d'origine, ici la colonne A. »

avec le fichier ci-dessous, les résultats seront en colonne B ;
colonne A inchangée ; même utilisation : fais Ctrl e

Option Explicit

Sub Essai()
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
  Dim Tbl, chn$, lng As Byte, c As Byte, p As Byte, i&
  Tbl = [A1].Resize(n, 2): Tbl(1, 2) = "string 2"
  For i = 2 To n
    chn = Tbl(i, 1): lng = Len(chn): c = 0
    If lng = 10 Then
      For p = 1 To 10
        c = c Xor Asc(Mid$(chn, p, 1))
      Next p
      Tbl(i, 2) = chn & Right$("0" & Hex$(c), 2)
    End If
  Next i
  Application.ScreenUpdating = 0: [A1].Resize(n, 2) = Tbl
End Sub

soan

 

[soan]

@decolit

lis d'abord mon post précédent.

ton post #11, tu as écrit : « En déclarant la fonction Chkxor de dranreb,
ce code très efficace de Phuocam (que je remercie) correspond à ce que
je veux sans avoir à appeler Chkxor »

bizarre, car d'après le code VBA que tu as montré, la sub CHAINXOR()
appelle bien la sub Chkxor() :

...Then Arr(i, 1) = Arr(i, 1) & Chkxor(Arr(i, 1))

dans la sub Essai() de mon code VBA (1ère et 2ème version), le xor est effectué
dans le corps de la sub Essai(), sans faire appel à une autre sub externe.

soan

 

[decolit]

@soan

Merci beaucoup pour ton message.
Chkxor : je voulais dire que l'utilisateur pas d'action à faire sur cette fonction, juste à lancer la macro. En effet, le sub fait appel à chkxor qui est présente dans un module de la feuille.

J'ai bien compris que ton code intègre le calcul du checksum xor. Je ne comprends pas pourquoi :

 If lng = 10 Then
      For p = 1 To 10

car les chaines peuvent avoir une longueur indéterminée.
Je vais essayer et te faire un retour

 

[soan]

oh, d'après le fichier de ton énoncé, je croyais que toutes tes chaînes étaient
longues de 10 caractères ! je vais modifier mon code VBA en conséquence.

soan