我找到了有关哈希函数的帖子，但由于错误而无法使用它们。自 2010 年以来，我再也没有使用过 VBA，所以这有点遥远，我无法调试它。
以下帖子提供了一个哈希函数：Excel 是否有函数可以创建哈希值？。
Public Function BASE64SHA1(ByVal sTextToHash As String)
Dim asc As Object
Dim enc As Object
Dim TextToHash() As Byte
Dim SharedSecretKey() As Byte
Dim bytes() As Byte
Const cutoff As Integer = 5
Set asc = CreateObject("System.Text.UTF8Encoding")
Set enc = CreateObject("System.Security.Cryptography.HMACSHA1")
TextToHash = asc.GetBytes_4(sTextToHash)
SharedSecretKey = asc.GetBytes_4(sTextToHash)
enc.Key = SharedSecretKey
bytes = enc.ComputeHash_2((TextToHash))
BASE64SHA1 = EncodeBase64(bytes)
BASE64SHA1 = Left(BASE64SHA1, cutoff)
Set asc = Nothing
Set enc = Nothing
End Function
Private Function EncodeBase64(ByRef arrData() As Byte) As String
Dim objXML As Object
Dim objNode As Object
Set objXML = CreateObject("MSXML2.DOMDocument")
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
EncodeBase64 = objNode.text
Set objNode = Nothing
Set objXML = Nothing
End Function
当我尝试从单元格中使用它时，我得到了#VALUE!
当尝试调试时，我发现这一行是问题的根源，无需更多信息：
Set asc = CreateObject("System.Text.UTF8Encoding")
最终目的是在发送工作表之前匿名化电子邮件。
答案1
我发现以下函数适用于 excel 2016。它仅使用 VBA，因此不会像其他函数一样使用损坏的依赖项。我本来希望有更快的函数（散列大约 600 000 封电子邮件大约需要 20-25 分钟），但目前我对此很满意。
Private Type FourBytes
a As Byte
b As Byte
c As Byte
d As Byte
End Type
Private Type OneLong
l As Long
End Type
Function HexDefaultSHA1(Message() As Byte) As String
Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
DefaultSHA1 Message, H1, H2, H3, H4, H5
HexDefaultSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function
Function HexSHA1(Message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long) As String
Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
xSHA1 Message, Key1, Key2, Key3, Key4, H1, H2, H3, H4, H5
HexSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function
Sub DefaultSHA1(Message() As Byte, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
xSHA1 Message, &H5A827999, &H6ED9EBA1, &H8F1BBCDC, &HCA62C1D6, H1, H2, H3, H4, H5
End Sub
Sub xSHA1(Message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
Dim U As Long, P As Long
Dim FB As FourBytes, OL As OneLong
Dim i As Integer
Dim w(80) As Long
Dim a As Long, b As Long, c As Long, d As Long, E As Long
Dim t As Long
H1 = &H67452301: H2 = &HEFCDAB89: H3 = &H98BADCFE: H4 = &H10325476: H5 = &HC3D2E1F0
U = UBound(Message) + 1: OL.l = U32ShiftLeft3(U): a = U \ &H20000000: LSet FB = OL 'U32ShiftRight29(U)
ReDim Preserve Message(0 To (U + 8 And -64) + 63)
Message(U) = 128
U = UBound(Message)
Message(U - 4) = a
Message(U - 3) = FB.d
Message(U - 2) = FB.c
Message(U - 1) = FB.b
Message(U) = FB.a
While P < U
For i = 0 To 15
FB.d = Message(P)
FB.c = Message(P + 1)
FB.b = Message(P + 2)
FB.a = Message(P + 3)
LSet OL = FB
w(i) = OL.l
P = P + 4
Next i
For i = 16 To 79
w(i) = U32RotateLeft1(w(i - 3) Xor w(i - 8) Xor w(i - 14) Xor w(i - 16))
Next i
a = H1: b = H2: c = H3: d = H4: E = H5
For i = 0 To 19
t = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(a), E), w(i)), Key1), ((b And c) Or ((Not b) And d)))
E = d: d = c: c = U32RotateLeft30(b): b = a: a = t
Next i
For i = 20 To 39
t = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(a), E), w(i)), Key2), (b Xor c Xor d))
E = d: d = c: c = U32RotateLeft30(b): b = a: a = t
Next i
For i = 40 To 59
t = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(a), E), w(i)), Key3), ((b And c) Or (b And d) Or (c And d)))
E = d: d = c: c = U32RotateLeft30(b): b = a: a = t
Next i
For i = 60 To 79
t = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(a), E), w(i)), Key4), (b Xor c Xor d))
E = d: d = c: c = U32RotateLeft30(b): b = a: a = t
Next i
H1 = U32Add(H1, a): H2 = U32Add(H2, b): H3 = U32Add(H3, c): H4 = U32Add(H4, d): H5 = U32Add(H5, E)
Wend
End Sub
Function U32Add(ByVal a As Long, ByVal b As Long) As Long
If (a Xor b) < 0 Then
U32Add = a + b
Else
U32Add = (a Xor &H80000000) + b Xor &H80000000
End If
End Function
Function U32ShiftLeft3(ByVal a As Long) As Long
U32ShiftLeft3 = (a And &HFFFFFFF) * 8
If a And &H10000000 Then U32ShiftLeft3 = U32ShiftLeft3 Or &H80000000
End Function
Function U32ShiftRight29(ByVal a As Long) As Long
U32ShiftRight29 = (a And &HE0000000) \ &H20000000 And 7
End Function
Function U32RotateLeft1(ByVal a As Long) As Long
U32RotateLeft1 = (a And &H3FFFFFFF) * 2
If a And &H40000000 Then U32RotateLeft1 = U32RotateLeft1 Or &H80000000
If a And &H80000000 Then U32RotateLeft1 = U32RotateLeft1 Or 1
End Function
Function U32RotateLeft5(ByVal a As Long) As Long
U32RotateLeft5 = (a And &H3FFFFFF) * 32 Or (a And &HF8000000) \ &H8000000 And 31
If a And &H4000000 Then U32RotateLeft5 = U32RotateLeft5 Or &H80000000
End Function
Function U32RotateLeft30(ByVal a As Long) As Long
U32RotateLeft30 = (a And 1) * &H40000000 Or (a And &HFFFC) \ 4 And &H3FFFFFFF
If a And 2 Then U32RotateLeft30 = U32RotateLeft30 Or &H80000000
End Function
Function DecToHex5(ByVal H1 As Long, ByVal H2 As Long, ByVal H3 As Long, ByVal H4 As Long, ByVal H5 As Long) As String
Dim H As String, l As Long
DecToHex5 = "00000000 00000000 00000000 00000000 00000000"
H = Hex(H1): l = Len(H): Mid(DecToHex5, 9 - l, l) = H
H = Hex(H2): l = Len(H): Mid(DecToHex5, 18 - l, l) = H
H = Hex(H3): l = Len(H): Mid(DecToHex5, 27 - l, l) = H
H = Hex(H4): l = Len(H): Mid(DecToHex5, 36 - l, l) = H
H = Hex(H5): l = Len(H): Mid(DecToHex5, 45 - l, l) = H
End Function
Public Function SHA1Trunc(str)
Dim i As Integer
Dim arr() As Byte
ReDim arr(0 To Len(str) - 1) As Byte
Const cutoff As Integer = 40
For i = 0 To Len(str) - 1
arr(i) = Asc(Mid(str, i + 1, 1))
Next i
SHA1Trunc = Replace(LCase(HexDefaultSHA1(arr)), " ", "")
SHA1Trunc = Left(SHA1Trunc, cutoff)
End Function
资料来源：