[ olvejz @ 15.04.2019. 09:52 ] @
Rezultat VBA funkcije je string, koji bih trebao da obojim u zavisnosti od rezultata : 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 |