|
|
- '//////////////////////////////////////////////////////////
- '输入值：统一代码（三证合一）： 如: 91340828578527976Q
- '函数： checkSCC(StrUniCode)
- '参数： StrUniCode 为输入的统一代码
- '返回值:
- ' 0 = 检验位错
- ' -1 = 检验通过
- ' -2 = 验证格式错误
- ' -3 = 计算错误（也属于格式错误)
- ' -4 = 其他错误（如果出现-4，应检查还有其他没有考虑到的错误)
- 'Make By：～苦笑人生（QQ：42001979) 10:52 2016-02-14
- '如有不足之处，欢迎批评指证，VBA交流
- '//////////////////////////////////////////////////////////
- '参照标准：
- '附件：《GB_32100-2015_法人和其他组织统一社会信用代码编码规则.》
- '按照编码规则:
- '统一代码为18位，统一代码由十八位的数字或大写英文字母（不适用I、O、Z、S、V）组成，由五个部分组成：
- '第一部分（第1位）为登记管理部门代码，9表示工商部门；
- '第二部分（第2位）为机构类别代码，1-企业、2-个体工商户、3-农民专业合作社 9-其他
- '第三部分（第3-8位）为登记管理机关行政区划码；
- '第四部分（第9-17位）为全国组织机构代码；
- '第五部分（第18位）为校验码
- Sub test()
- '//测试数据，部分来自百度图片
- a = checkSCC("91350100M000100Y43")
- a = checkSCC("91430382092581024J")
- a = checkSCC("914103057167119596")
- a = checkSCC("9A350100M000100Y47")
- a = checkSCC("91340828578527976Q")
- a = checkSCC("91350128M00000019A")
- a = checkSCC("52100000523000026F")
- a = checkSCC("91350200M000000510")
- a = checkSCC("91520421MA6DJ09246")
- a = checkSCC("91440300359143307G")
- a = checkSCC("91340881MA2MQ0T315")
- End Sub
- Function checkSCC(StrUniCode)
- Application.Volatile
-
- On Error GoTo ErrHand
-
- StrUniCode = UCase(StrUniCode)
-
- Dim Wf As String '//代码字符集-代码字符
- Dim Wi As Variant '//各位置序号上的（加权因子）
-
- Wf = "0123456789ABCDEFGHJKLMNPQRTUWXY"
- Wi = Array(1, 3, 9, 27, 19, 26, 16, 17, 20, 29, 25, 13, 8, 24, 10, 30, 28)
- Dim RegEx
- Set RegEx = New RegExp '建立正则表达式。
-
- RegEx.Pattern = "^([0-9ABCDEFGHJKLMNPQRTUWXY]{2})(\d{6})([0-9ABCDEFGHJKLMNPQRTUWXY]{9})([0-9ABCDEFGHJKLMNPQRTUWXY])$"
-
- If Not RegEx.Test(StrUniCode) Then
- Err.Raise vbObjectError + 10, 0, "验证格式错误"
- End If
-
- Dim Total As Long '//奇偶校验汇总（求和）
- Dim LastNum As String * 1 '//输入校验位
- Dim chkDigit As String * 1 '//计算校验位
- Dim OrgCode As String '//全国组织机构代码
-
- LastNum = Right(StrUniCode, 1) '最后1位
- OrgCode = Mid(StrUniCode, 9, 9)
-
- Dim i As Integer '//循环变量
- Dim iPos As Integer '//位置变量
- Dim CurrentDigit As String '//循环每1位字符
-
- For i = 1 To Len(StrUniCode) - 1 '定长17位
- CurrentDigit = Mid(StrUniCode, i, 1) '取每1位字符
- iPos = InStr(Wf, CurrentDigit) '查找位置
- If iPos > 0 Then
- Total = Total + Wi(i - 1) * (iPos - 1)
- Else
- Err.Raise vbObjectError + 20, 0, "计算错误"
- End If
- Next
- iPos = (31 - Total Mod 31)
- chkDigit = Mid(Wf, iPos + 1, 1)
- ' If iPos < 10 Then
- ' chkDigit = CStr(iPos)
- ' Else
- ' chkDigit = Mid(WF, iPos + 1, 1)
- ' End If
- ErrHand:
- Select Case Err.Number
- Case 0
- checkSCC = CInt(LastNum = chkDigit)
- Case vbObjectError + 10
- checkSCC = -2
- Case vbObjectError + 20
- checkSCC = -3
- Case Else
- checkSCC = -4
- End Select
- Debug.Print "统一代码:" & StrUniCode, "组织机构:" & OrgCode, "校验汇总:" & Total, "位置:" & iPos & "-->" & chkDigit, "结果:" & IIf(chkDigit = LastNum, "正确", "错误应为" & chkDigit)
- End Function
- '测试结果：
- '统一代码:91350100M000100Y43 组织机构:M000100Y4 校验汇总:1640 位置:3-->3 结果:正确
- '统一代码:91430382092581024J 组织机构:092581024 校验汇总:1005 位置:18-->J 结果:正确
- '统一代码:914103057167119596 组织机构:716711959 校验汇总:1172 位置:6-->6 结果:正确
- '统一代码:9A350100M000100Y47 组织机构:M000100Y4 校验汇总:1667 位置:7-->7 结果:正确
- '统一代码:91340828578527976Q 组织机构:578527976 校验汇总:1743 位置:24-->Q 结果:正确
- '统一代码:91350128M00000019A 组织机构:M00000019 校验汇总:1070 位置:15-->F 结果:错误应为F
- '统一代码:52100000523000026F 组织机构:523000026 校验汇总:481 位置:15-->F 结果:正确
- '统一代码:91350200M000000510 组织机构:M00000051 校验汇总:824 位置:13-->D 结果:错误应为D
- '统一代码:91520421MA6DJ09246 组织机构:MA6DJ0924 校验汇总:1699 位置:6-->6 结果:正确
- '统一代码:91440300359143307G 组织机构:359143307 校验汇总:1007 位置:16-->G 结果:正确
- '统一代码:91340881MA2MQ0T315 组织机构:MA2MQ0T31 校验汇总:2103 位置:5-->5 结果:正确
|
|
/1 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2016-2-14 10:56
