ИНН валидация на VBA

Function INN_String_Valid(sINN As String) As Boolean

   Static retu As Boolean
   
   Static a1() As Variant
   a1 = String2Array1(sINN)

   Select Case Len(sINN)
      Case 10
         retu = INN_10_A1_Check(a1)
      Case 12
         retu = INN_12_A1_Check(a1)
      Case Else
         retu = False
   End Select

   INN_String_Valid = retu

End Function


Function INN_10_A1_Check(a1 As Variant) As Boolean
   ' проверить 10 значный ИНН
   
   ' Вычисляется контрольная сумма со следующими весовыми коэффициентами: (2,4,10,3,5,9,4,6,8,0)
   
   Static summ_Control As Long
   summ_Control = A1s_SumProduct(a1, Array(2, 4, 10, 3, 5, 9, 4, 6, 8, 0))
      
   If summ_Control = 0 Then Stop
   
   ' Вычисляется контрольное число как остаток от деления контрольной суммы на 11
   
   Static num_Control As Long
   num_Control = summ_Control Mod 11
   
   ' Если контрольное число больше 9, то контрольное число вычисляется как остаток от деления контрольного числа на 10
   
   If num_Control > 9 Then num_Control = summ_Control Mod 10
   
   ' Контрольное число проверяется с десятым знаком ИНН. В случае их равенства ИНН считается правильным
   
   If num_Control = a1(UBound(a1)) Then INN_10_A1_Check = True
   
End Function


Function INN_12_A1_Check(a1 As Variant) As Boolean
   ' Проверить 12значный ИНН

   '1. Вычисляется контрольная сумма по 11-ти знакам со следующими весовыми коэффициентами: (7,2,4,10,3,5,9,4,6,8,0)
   
   Static a1_11 As Variant
   a1_11 = a1
   ReDim Preserve a1_11(LBound(a1) To UBound(a1) - 1)
   
   Static summ_Control As Long
   summ_Control = A1s_SumProduct(a1_11, Array(7, 2, 4, 10, 3, 5, 9, 4, 6, 8, 0))
   
   If summ_Control = 0 Then Stop
   
   '2. Вычисляется контрольное число(1) как остаток от деления контрольной суммы на 11
   
   Static num_Control_01 As Long
   num_Control_01 = summ_Control Mod 11
   
   '3. Если контрольное число(1) больше 9, то контрольное число(1) вычисляется как
   ' остаток от деления контрольного числа(1) на 10
   
   If num_Control_01 > 9 Then num_Control_01 = summ_Control Mod 10
   
   '4. Вычисляется контрольная сумма по 12-ти знакам со следующими весовыми коэффициентами: (3,7,2,4,10,3,5,9,4,6,8,0).
   summ_Control = A1s_SumProduct(a1, Array(3, 7, 2, 4, 10, 3, 5, 9, 4, 6, 8, 0))
   
   If summ_Control = 0 Then Stop
   
   '5. Вычисляется контрольное число(2) как остаток от деления контрольной суммы на 11
   
   Static num_Control_02 As Long
   num_Control_02 = summ_Control Mod 11
   
   '6. Если контрольное число(2) больше 9, то контрольное число(2) вычисляется как
   ' остаток от деления контрольного числа(2) на 10
   If num_Control_02 > 9 Then num_Control_02 = summ_Control Mod 10
   
   '7. Контрольное число(1) проверяется с одиннадцатым знаком ИНН и
   '   контрольное число(2) проверяется с двенадцатым  знаком ИНН.
   ' В случае их равенства ИНН считается правильным.

   If _
      num_Control_01 = a1(UBound(a1) - 1) And _
      num_Control_02 = a1(UBound(a1)) Then _
      INN_12_A1_Check = True

End Function


Function String2Array1( _
   sValue As String) _
   As Variant
   ' строку в массив 1мерный

   Static a1 As Variant
   ReDim a1(0 To Len(sValue) - 1)

   Static idx As Long
            
   For idx = LBound(a1) To UBound(a1)
      a1(idx) = Mid$(sValue, idx + 1, 1)
   Next idx
    
   String2Array1 = a1
    
End Function


Function A1s_SumProduct(a1 As Variant, a2 As Variant) As Double
   ' массивы 1мерные - перемножить столбцы.
   ' WorksheetFunction.SumProduct перемножает только, если в массивах числа

   Dim retu As Double
   Static row_ As Long
                  
   For row_ = LBound(a1) To UBound(a1)
      
      If IsNumeric(a1(row_)) Then
         
         If IsNumeric(a2(row_)) Then
      
            retu = retu + (a1(row_) * a2(row_))
   
         End If
      End If
   Next row_

   A1s_SumProduct = retu

End Function



'@TestMethod
Sub INN_10_A1_Check_TestMethod()
   On Error GoTo TestFail
   Dim varReturn As Boolean
   Dim a1 As Variant
   a1 = Array(6, 8, 2, 9, 0, 0, 0, 1, 3, 0)
   varReturn = INN_10_A1_Check(a1)
   If varReturn = False Then Err.Raise 567, , "INN_10_A1_Check(a1)"
   
   a1 = Array(5, 8, 2, 9, 0, 0, 0, 1, 3, 0)
   varReturn = INN_10_A1_Check(a1)
   If varReturn Then Err.Raise 567, , "INN_10_A1_Check(a1)"
   
   Mock.wb.Close False
   Exit Sub
TestFail:
   Mock.wb.Close False
   Assert.Fail "Test error: #" & Err.Number & " - " & Err.Description
End Sub


'@TestMethod
Sub INN_12_A1_Check_TestMethod()
   On Error GoTo TestFail
   Dim varReturn As Boolean
   Dim a1 As Variant
   
   a1 = Array(6, 8, 2, 0, 0, 6, 6, 8, 3, 5, 9, 4)
   varReturn = INN_12_A1_Check(a1)
   If varReturn = False Then Err.Raise 567, , "INN_12_A1_Check(a1)"
   
   a1 = Array(5, 8, 2, 0, 0, 6, 6, 8, 3, 5, 9, 4)
   varReturn = INN_12_A1_Check(a1)
   If varReturn Then Err.Raise 567, , "INN_12_A1_Check(a1)"
   
   Mock.wb.Close False
   Exit Sub
TestFail:
   Mock.wb.Close False
   Assert.Fail "Test error: #" & Err.Number & " - " & Err.Description
End Sub


'@TestMethod
Sub INN_String_Valid_TestMethod()
'   On Error GoTo TestFail
   Dim varReturn As Boolean
   Dim sINN As String
   
   sINN = "6829000130"
   varReturn = INN_String_Valid(sINN)
   If varReturn = False Then Err.Raise 567, , "INN_String_Valid(sINN)"
   
   sINN = "6829000131"
   varReturn = INN_String_Valid(sINN)
   If varReturn Then Err.Raise 567, , "INN_String_Valid(sINN)"
   
   sINN = "683210838056"
   varReturn = INN_String_Valid(sINN)
   If varReturn = False Then Err.Raise 567, , "INN_String_Valid(sINN)"
   
   sINN = "683210838057"
   varReturn = INN_String_Valid(sINN)
   If varReturn Then Err.Raise 567, , "INN_String_Valid(sINN)"
   
   Mock.wb.Close False
   Exit Sub
TestFail:
   Mock.wb.Close False
   Assert.Fail "Test error: #" & Err.Number & " - " & Err.Description
End Sub


'@TestMethod
Sub A1s_SumProduct_TestMethod()
   On Error GoTo TestFail
   Dim varReturn As Double
   Dim a1 As Variant
   Dim a2 As Variant
   a1 = Array(3, 2)
   a2 = Array("3", "2")
   varReturn = A1s_SumProduct(a1, a2)
   If varReturn <> 13 Then Err.Raise 567, , "A1s_SumProduct(a1,a2)"
   Mock.wb.Close False
   Exit Sub
TestFail:
   Mock.wb.Close False
   Assert.Fail "Test error: #" & Err.Number & " - " & Err.Description
End Sub


Оставить комментарий

Этот сайт использует Akismet для борьбы со спамом. Узнайте, как обрабатываются ваши данные комментариев.