Greska u duzini - crveno
Nepoznat karakter - zuto
funkcija se na radnom listu poziva :
kbr(IDMM)
IDMM su stringovi u nekoj koloni, a kbr je rezultat izracunavanja.
Evo funkcije :
*****************************************************
Public Function kbr(IDMM As String) As String
Dim idmm1 As String
Dim AlfaStr As String, AlfaNum As Long, Alfa1 As String
Dim Suma As Long
Dim Check As Long
' *********************** Ako je duzina IDMM manja od 15 karaktera **************************
If Len(IDMM) <> 15 Then
kbr = "Greska u duzini"
Exit Function
End If
' ********************************
' ************* Ako neki od karaktera IDMM ne postoji u Alfastr *******************
For k = 1 To Len(IDMM)
If InStr("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-", Mid(IDMM, k, 1)) = 0 Then
kbr = "Nepoznat karakter"
Exit Function
End If
Next
' *****************************
AlfaStr = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-"
Suma = 0
For i = 1 To Len(IDMM)
AlfaNum = InStr(1, AlfaStr, Mid(IDMM, i, 1)) - 1
Suma = Suma + AlfaNum * (17 - i)
Next i
Check = (36 - ((Suma - 1) Mod 37))
' **************************************************
If Check = 36 Then
idmm1 = Mid(IDMM, 1, 3) & "1" & Mid(IDMM, 5, Len(IDMM))
Suma = 0
For i = 1 To Len(idmm1)
AlfaNum = InStr(1, AlfaStr, Mid(idmm1, i, 1)) - 1
Suma = Suma + AlfaNum * (17 - i)
Next i
Check = (36 - ((Suma - 1) Mod 37))
IDMM = idmm1
End If
' **********************************************
kbr = Mid(AlfaStr, Check + 1, 1)
Alfa1 = IDMM & kbr
kbr = Alfa1
End Function
xxx