Chaîne de hachage VBA

Diviser votre chaîne en trois courtes chaînes (si pas divisible par trois, le dernier sera plus long que les deux autres). Exécuter votre "court" de l'algorithme sur chaque, et concaténer les résultats.

Je pourrais écrire du code, mais en fonction de la qualité de la question, je pense que vous pouvez le prendre à partir d'ici!

EDIT: Il s'avère que ce conseil n'est pas assez. Il y a un grave défaut dans votre original CRC16 code - à savoir la ligne qui dit:

j = Val("&H" + Mid(txt, nC, 2))

Ce ne gère qu'un texte qui peut être interprété en tant que valeurs hexadécimales: les minuscules et les majuscules sont les mêmes, et rien après F de l'alphabet est ignoré (autant que je puisse en dire). Que rien de bon sort à tous est un miracle. Si vous remplacez la ligne par

j = asc(mid(txt, nC, 1))

Les choses fonctionnent mieux chaque code ASCII au moins commence la vie de sa propre valeur.

Combinant cette modification à la proposition que j'ai fait, vous obtenez le code suivant:

Function hash12(s As String)
' create a 12 character hash from string s

Dim l As Integer, l3 As Integer
Dim s1 As String, s2 As String, s3 As String

l = Len(s)
l3 = Int(l / 3)
s1 = Mid(s, 1, l3)      ' first part
s2 = Mid(s, l3 + 1, l3) ' middle part
s3 = Mid(s, 2 * l3 + 1) ' the rest of the string...

hash12 = hash4(s1) + hash4(s2) + hash4(s3)

End Function

Function hash4(txt)
' copied from the example
Dim x As Long
Dim mask, i, j, nC, crc As Integer
Dim c As String

crc = &HFFFF

For nC = 1 To Len(txt)
    j = Asc(Mid(txt, nC)) ' <<<<<<< new line of code - makes all the difference
    ' instead of j = Val("&H" + Mid(txt, nC, 2))
    crc = crc Xor j
    For j = 1 To 8
        mask = 0
        If crc / 2 <> Int(crc / 2) Then mask = &HA001
        crc = Int(crc / 2) And &H7FFF: crc = crc Xor mask
    Next j
Next nC

c = Hex$(crc)

' <<<<< new section: make sure returned string is always 4 characters long >>>>>
' pad to always have length 4:
While Len(c) < 4
  c = "0" & c
Wend

hash4 = c

End Function

Vous pouvez placer ce code dans votre feuille de calcul en tant que =hash12("A2") etc. Pour le fun, vous pouvez également utiliser la fonction "nouveau et amélioré" hash4 algorithme, et de voir comment ils se comparent. J'ai créé un tableau croisé dynamique à compter de collisions - il n'y avait personne pour l' hash12 algorithme, et seulement 3 pour le hash4. Je suis sûr que vous pouvez comprendre comment créer hash8... à partir de cela. La "pas besoin d'être unique" à partir de votre question suggère que peut-être le "meilleur" hash4 est tout ce dont vous avez besoin.

En principe, un caractère de quatre hex doit avoir de 64 ko de valeurs uniques: si la chance des deux chaînes aléatoires ayant le même hash serait de 1 à 64 ko. Lorsque vous avez de 400 chaînes, il y a 400 x 399 /2 "collision possible paires" ~ 80k possibilités (en supposant que vous avez eu très aléatoire de chaînes de caractères). L'observation de trois collisions dans l'échantillon de données est donc pas déraisonnable de score. Comme votre nombre de cordes N augmente, la probabilité de collisions se passe comme le carré de N., Avec le supplément de 32 bits d'information dans le hash12, vous vous attendez à voir les collisions lorsque N > 20 M (handwaving, dans-ma-tête-math).

Vous pouvez faire la hash12 code un peu plus compact, bien sûr - et il devrait être facile de voir comment l'étendre à toute la longueur.

Oh et une dernière chose. Si vous avez des RC aborder activé à l'aide de =CRC16("string") comme une feuille de calcul formule donne un dur-à-piste #REF erreur... c'est pourquoi je l'ai renommé hash4

Pour l'enregistrement, celui-ci génère rapidement un 32 bits de hachage avec un faible niveau de collision:

Public Function HashFNV(txt As String) As Long
  Const max# = 2 ^ 31
  Dim hash#, upper&, i&
  If txt = Empty Then Exit Function
  hash = &H11C9DC5
  For i = 1 To Len(txt)
    hash = 31# * (hash - upper * max Xor AscW(Mid$(txt, i, 1)))
    upper = hash / max
  Next
  HashFNV = hash - upper * max Or &H80000000 * (upper And 1&)
End Function