Function isVIN(VIN As String) As Boolean ' 检查车架号VIN是否符合标准 ' 参数: ' VIN:需要检查的车架号字符串 ' 返回值: ' Boolean: 正确返回True,错误返回False If TypeName(VIN) <> "String" Then ' 如果不是文本,退出检查 isVIN = False Exit Function End If If Len(Trim(VIN)) <> 17 Then ' 如果没有17位,退出检查 isVIN = False Exit Function End If VIN = UCase(VIN) Dim RE As Object Set RE = CreateObject("VBScript.RegExp") RE.Pattern = "^[A-HJ-NPR-Z\d]{8}[X\d][A-HJ-NPR-Z\d]{3}\d{5}$" If Not RE.Test(VIN) Then ' 如果不符合正则要求,退出检查 isVIN = False Exit Function End If Dim cOT As Object Set cOT = CreateObject("Scripting.Dictionary") cOT.Add "0", 0 cOT.Add "1", 1 cOT.Add "2", 2 cOT.Add "3", 3 cOT.Add "4", 4 cOT.Add "5", 5 cOT.Add "6", 6 cOT.Add "7", 7 cOT.Add "8", 8 cOT.Add "9", 9 cOT.Add "A", 1 cOT.Add "B", 2 cOT.Add "C", 3 cOT.Add "D", 4 cOT.Add "E", 5 cOT.Add "F", 6 cOT.Add "G", 7 cOT.Add "H", 8 cOT.Add "J", 1 cOT.Add "K", 2 cOT.Add "L", 3 cOT.Add "M", 4 cOT.Add "N", 5 cOT.Add "P", 7 cOT.Add "R", 9 cOT.Add "S", 2 cOT.Add "T", 3 cOT.Add "U", 4 cOT.Add "V", 5 cOT.Add "W", 6 cOT.Add "X", 7 cOT.Add "Y", 8 cOT.Add "Z", 9 Dim xWT As Variant xWT = Array(8, 7, 6, 5, 4, 3, 2, 10, 0, 9, 8, 7, 6, 5, 4, 3, 2) Dim sum As Long For i = 1 To 17 sum = sum + cOT(Mid(VIN, i, 1)) * xWT(i - 1) Next i Dim cT As Variant cT = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "X") isVIN = (cT(sum Mod 11) = Mid(VIN, 9, 1)) End Function