Question

我需要检查JMBG（我国的独特公民身份）。它有13个数字，由以下代码计算。该函数返回我的JMBG错误。也许在代码的某处我做错了计算。

这是一个例子。现实生活JMBG是0805988212987，这个函数返回错误的月份。

Function Check_JMBG(JMBG As String) As String

' Function returns message with notification of JMBG validation
' JMBG has 13 numbers and can be treated like this when checking it DD.MM.GGG.OO.BBB.K
' Details of JMBG (unique citizenship number in my country, is 13 by the way):

'DD - day of birth
'MM - manth of birth
'GGG - last 3 numbers of year of birth, starting from (1)899. year
'OO - municipality birth code
'BBB - serial number of birth person. Man from 001-499, woman from 501-999
'K - control number, modulo 11

Dim size As Integer, sum As Integer
Dim number(1 To 13) As Integer
Dim day As Integer, manth As Integer, year As String

size = Len(JMBG)
day = Int(Left(JMBG, 2))
manth = Int(Mid$(JMBG, 3, 2))
year = Mid$(JMBG, 5, 3)

' Size check
If (size <> 13) Then
  Check_JMBG = "ERR: size of JMBG is not 13!"
End If

'Date check
If day < 1 Then
  Check_JMBG = "ERR: date entered is wrong!"
  Exit Function
End If

'Manth check and date inside manth
Select Case manth
  Case 1, 3, 5, 7, 8, 10, 12
    If day > 31 Then
      Check_JMBG = "ERR: date number is wrong!"
      Exit Function
    End If
  Case 4, 6, 9, 11
    If day > 30 Then
      Check_JMBG = "ERR: data number is wrong!"
      Exit Function
    End If
  Case 2
    If ((year Mod 4 = 0) And day > 29) Or _
       ((year Mod 4 <> 0) And day > 28) Then
      Check_JMBG = "ERR: date number is wrong!"
      Exit Function
    End If
  Case Else
    Check_JMBG = "ERR: manth number is wrong!"
    Exit Function
End Select

'Check year: from 1899 till today
If (year > Right(str(Year(Now)), 3)) And (year < "899") Then
  Check_JMBG = "ERR: year number is wrong!"
  Exit Function
End If

'Control number check
For i = 1 To 13
  number(i) = Int(Mid$(JMBG, i, 1))
Next i

sum = number(13) + number(1) * 7 + number(2) * 6
sum = sum + number(3) * 5 + number(4) * 4
sum = sum + number(5) * 3 + number(6) * 2
sum = sum + number(7) * 7 + number(8) * 6
sum = sum + number(9) * 5 + number(10) * 4
sum = sum + number(11) * 3 + number(12) * 2

If (sum Mod 11) <> 0 Then
  Check_JMBG = "ERR: wrong control number!"
Else
  Check_JMBG = "JMBG is correct"
End If

End Function

Answer 1

您的函数需要一个字符串，并且您正在传递一个数字。由于在尺寸检查后没有退出该功能，因此您没有收到错误。

=Check_JMBG(805988212987)错误 manth is wrong

=Check_JMBG("0805988212987")提供消息 JMBG正确

formatting makes a difference

请注意单元格A1左上方的绿色三角形...这意味着我已通过在数字前添加'（单引号）将数字作为文本输入。

您可以稍微改变您的测试以覆盖缺失的零。 - 在您获得大小之后，在提取日，月和年之前，请输入以下代码：

If (size <> 13) Then
    'add leading zeros
    JMBG = String(13 - size, "0") & JMBG
End If

完整代码：

Function Check_JMBG(JMBG As String) As String

' Function returns message with notification of JMBG validation
' JMBG has 13 numbers and can be treated like this when checking it DD.MM.GGG.OO.BBB.K
' Details of JMBG (unique citizenship number in my country, is 13 by the way):

'DD - day of birth
'MM - manth of birth
'GGG - last 3 numbers of strYear of brith, starting from (1)899. strYear
'OO - municipality birth code
'BBB - serial number of birth person. Man from 001-499, woman from 501-999
'K - control number, modulo 11

Dim size As Integer, sum As Integer
Dim number(1 To 13) As Integer
Dim day As Integer, manth As Integer, strYear As String

size = Len(JMBG)

' Size check
If (size <> 13) Then
  JMBG = String(13 - size, "0") & JMBG
End If

day = Int(Left(JMBG, 2))
manth = Int(Mid$(JMBG, 3, 2))
strYear = Mid$(JMBG, 5, 3)

'Date check
If day < 1 Then
  Check_JMBG = "ERR: date entered is wrong!"
  Exit Function
End If

'Manth check and date inside manth
Select Case manth
  Case 1, 3, 5, 7, 8, 10, 12
    If day > 31 Then
      Check_JMBG = "ERR: date number is wrong!"
      Exit Function
    End If
  Case 4, 6, 9, 11
    If day > 30 Then
      Check_JMBG = "ERR: data number is wrong!"
      Exit Function
    End If
  Case 2
    If ((strYear Mod 4 = 0) And day > 29) Or _
       ((strYear Mod 4 <> 0) And day > 28) Then
      Check_JMBG = "ERR: date number is wrong!"
      Exit Function
    End If
  Case Else
    Check_JMBG = "ERR: month number is wrong!"
    Exit Function
End Select

'Check strYear: from 1899 till today
If (strYear > Right(str(Year(Now)), 3)) And (strYear < "899") Then
  Check_JMBG = "ERR: strYear number is wrong!"
  Exit Function
End If

'Control number check
For i = 1 To 13
  number(i) = Int(Mid$(JMBG, i, 1))
Next i

sum = number(13) + number(1) * 7 + number(2) * 6
sum = sum + number(3) * 5 + number(4) * 4
sum = sum + number(5) * 3 + number(6) * 2
sum = sum + number(7) * 7 + number(8) * 6
sum = sum + number(9) * 5 + number(10) * 4
sum = sum + number(11) * 3 + number(12) * 2

If (sum Mod 11) <> 0 Then
  Check_JMBG = "ERR: wrong control number!"
Else
  Check_JMBG = "JMBG is correct"
End If

End Function

Answer 2

我运行了你的代码，这个月工作正常。我有一个编译错误，因为你对变量year和VBA函数使用相同的名字 - 一旦我用strYear替换它，这也有效。

看看下面重构的代码，看看这是否能解决您的问题：

Function Check_JMBG(JMBG As String) As String
    If (Len(JMBG) <> 13) Then
        Check_JMBG = "ERR: Length of JMBG is not 13!"
    ElseIf Not IsNumeric(JMBG) Then
        Check_JMBG = "ERR: JMBG contains non-numerical characters"
    ElseIf Not fctBlnCheckDate(JMBG) Then
        Check_JMBG = "ERR: Wrong date entered!"
    ElseIf fctBlnCheckSum(JMBG) Then
        Check_JMBG = "ERR: Wrong checksum!"
    Else
        Check_JMBG = "JMBG is correct"
    End If
End Function

Private Function fctBlnCheckDate(JMBG As String) As Boolean
    Dim intDay As Integer, intMonth As Integer, intYear As Integer
    Dim datCheck As Date

    intDay = Int(Left(JMBG, 2))
    intMonth = Int(Mid$(JMBG, 3, 2))
    intYear = Int(Mid$(JMBG, 5, 3)) + 1000

    datCheck = DateSerial(intYear, intMonth, intDay)

    fctBlnCheckDate = _
        (year(datCheck) = intYear) And _
        (Month(datCheck) = intMonth) And _
        (day(datCheck) = intDay)

End Function

Private Function fctBlnCheckSum(JMBG As String) As Boolean
    Dim intCheckSum As Integer, i As Integer

    For i = 1 To 13
        intCheckSum = intCheckSum + Int(Mid$(JMBG, i, 1)) * (IIf(i < 7, 8, 14) - i)
    Next 
    fctBlnCheckSum = (intCheckSum Mod 11) <> 0 
End Function

检查唯一号码

2 个答案: