Perfezionare una routine che effettua il controllo formale dei codici fiscali in base ad alcuni parametri particolari.

Question

Perfezionare una routine che effettua il controllo formale dei codici fiscali in base ad alcuni parametri particolari.

Anonimo

Buona sera a tutti.

Da molto tempo ho utilizzato la seguente funzione ( trovata in rete ) che mi effettua il controllo dei codici fiscali dei dipendenti inseriti in una determinata cella ( A2).

La eseguo in questo modo:

in B2 =VerificaCodFis(A2)

Option Explicit

Public Function VerificaCodFis(ByVal sCF As String) As Variant

Dim oRE As RegExp

Dim oMatch As MatchCollection

Dim sPatt As String

Dim j As Integer

Dim nHash As Integer

Dim vRet As Variant

Dim aOddTable As Variant

Dim aEvenTable As Variant

Dim aCarryTable As Variant

'Tabella dei caratteri dispari

aOddTable = Array(Array("0", 1), Array("1", 0), Array("2", 5), Array("3", 7), _

          Array("4", 9), Array("5", 13), Array("6", 15), Array("7", 17), \_ 

          Array("8", 19), Array("9", 21), Array("A", 1), Array("B", 0), \_ 

          Array("C", 5), Array("D", 7), Array("E", 9), Array("F", 13), \_ 

          Array("G", 15), Array("H", 17), Array("I", 19), Array("J", 21), \_ 

          Array("K", 2), Array("L", 4), Array("M", 18), Array("N", 20), \_ 

          Array("O", 11), Array("P", 3), Array("Q", 6), Array("R", 8), \_ 

          Array("S", 12), Array("T", 14), Array("U", 16), Array("V", 10), \_ 

          Array("W", 22), Array("X", 25), Array("Y", 24), Array("Z", 23))

'Tabella dei caratteri pari

aEvenTable = Array(Array("0", 0), Array("1", 1), Array("2", 2), Array("3", 3), _

            Array("4", 4), Array("5", 5), Array("6", 6), Array("7", 7), \_ 

            Array("8", 8), Array("9", 9), Array("A", 0), Array("B", 1), \_ 

            Array("C", 2), Array("D", 3), Array("E", 4), Array("F", 5), \_ 

            Array("G", 6), Array("H", 7), Array("I", 8), Array("J", 9), \_ 

            Array("K", 10), Array("L", 11), Array("M", 12), Array("N", 13), \_ 

            Array("O", 14), Array("P", 15), Array("Q", 16), Array("R", 17), \_ 

            Array("S", 18), Array("T", 19), Array("U", 20), Array("V", 21), \_ 

            Array("W", 22), Array("X", 23), Array("Y", 24), Array("Z", 25))

'Tabella dei verifica del carattere di controllo

aCarryTable = Array(Array(0, "A"), Array(1, "B"), Array(2, "C"), Array(3, "D"), _

            Array(4, "E"), Array(5, "F"), Array(6, "G"), Array(7, "H"), \_ 

            Array(8, "I"), Array(9, "J"), Array(10, "K"), Array(11, "L"), \_ 

            Array(12, "M"), Array(13, "N"), Array(14, "O"), Array(15, "P"), \_ 

            Array(16, "Q"), Array(17, "R"), Array(18, "S"), Array(19, "T"), \_ 

            Array(20, "U"), Array(21, "V"), Array(22, "W"), Array(23, "X"), \_ 

            Array(24, "Y"), Array(25, "Z"))

'controllo correttezza sintattica tramite RegEx

vRet = False

Set oRE = New RegExp 'CreateObject("vbscript.regexp")

sPatt = "^[A-Z]{6}[0-9]{2}[ABCDEHLMPRST][0-9]{2}A-Z[A-Z]$"

With oRE

.Global = True 

.ignorecase = True 

oRE.pattern = sPatt 

If oRE.Test(sCF) Then 

  'controllo correttezza semantica tramite verifica 16 carattere: 

  'il carattere della tabella aCarryTable, corrispondente al resto della somma 

  'dei valori dei 15 caratteri diviso 26, deve essere uguale al 16 carattere del c.f. 

  For j = 1 To 15 

    If Application.IsEven(j) Then 'pari 

      nHash = nHash + Application.VLookup(VBA.Mid(sCF, j, 1), aEvenTable, 2, 0) 

    Else 

      nHash = nHash + Application.VLookup(VBA.Mid(sCF, j, 1), aOddTable, 2, 0) 

    End If 

  Next 

  nHash = nHash Mod 26 

  If Application.VLookup(nHash, aCarryTable, 2, 0) = VBA.Right(sCF, 1) Then 

    vRet = True 

  End If 

End If

End With

Set oRE = Nothing

Set oMatch = Nothing

VerificaCodFis = vRet

End Function

Ho notato che sulla base di 60000 codici fiscali dei dipendenti controllati, solo quelli sotto riportati ( ho riportato solo gli ultimi 5 caratteri per privacy e per poter spiegare come sono strutturati) sono stati segnalati dalla funzione, come FALSO.

Premetto che i codici fiscali segnalati come FALSO li ho controllati tramite L'Agenzia delle Entrare e sono validi.

H5L1D
A6S2A
8P9Q
G2T3L
E7V1C
F8P9Q
F8P9Y
H5L1C
H5L1G
D7L8D
H2N4B
H5L1T
F8P9T
F8P9S
H5L1A
H5L1G
H5L1L
H5L1P
F8P9I
C3R1O

Questi codici fiscali, differenti dai soliti come per es :CNTNCL84A22E541A non terminano gli ultimi 4 caratteri con 3 cifre e 1 lettera, bensì con 1 cifra, 1 lettera, 1 cifra e 1 lettera finale.

Ciò posto, chiedo a voi professionisti se sia possibile nella routine gestire anche questi nuovi codici fiscali impostati nel modo in cui li ho specificati.

Spero di essere stato chiaro.

Ringrazio chi mi aiuta in questo.

Ciao, Nicola.

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti

Risposta accettata dall'autore della domanda

Eleuterio Tedeschi 18,750 Moderatore volontario

Io ti posso modificare l'espressione di controllo della Regex:

sPatt = "^[A-Z]{6}[0-9]{2}[ABCDEHLMPRST][0-9]{2}A-Z[A-Z]$"

ma non posso verificare la correttezza dei calcoli dell'hash.

Ciao.

0 commenti

7 risposte aggiuntive

Answer 1

Ho migliorato il codice implementando anche tutte le eccezioni dei codici fiscali e creando una funzione, scritta in VBA, compatibile con tutte le applicazioni Office (EXCEL, ACCESS, WORD, ecc...).

Function VerificaCodFis(sCF As Control) As Boolean

Dim oRE As Object

Dim sPatt As String

Dim j As Integer

Dim i As Byte

Dim nHash As Integer

Dim vRet As Variant

Dim aOddTable As Variant

Dim aEvenTable As Variant

Dim aCarryTable As Variant

Dim aTempTab As Variant

Dim aTemp As Variant

'tabella dei caratteri dispari

aOddTable = Array(Array("0", 1), Array("1", 0), Array("2", 5), Array("3", 7), _

        Array("4", 9), Array("5", 13), Array("6", 15), Array("7", 17), \_ 

        Array("8", 19), Array("9", 21), Array("A", 1), Array("B", 0), \_ 

        Array("C", 5), Array("D", 7), Array("E", 9), Array("F", 13), \_ 

        Array("G", 15), Array("H", 17), Array("I", 19), Array("J", 21), \_ 

        Array("K", 2), Array("L", 4), Array("M", 18), Array("N", 20), \_ 

        Array("O", 11), Array("P", 3), Array("Q", 6), Array("R", 8), \_ 

        Array("S", 12), Array("T", 14), Array("U", 16), Array("V", 10), \_ 

        Array("W", 22), Array("X", 25), Array("Y", 24), Array("Z", 23))

'tabella dei caratteri pari

aEvenTable = Array(Array("0", 0), Array("1", 1), Array("2", 2), Array("3", 3), _

         Array("4", 4), Array("5", 5), Array("6", 6), Array("7", 7), \_ 

         Array("8", 8), Array("9", 9), Array("A", 0), Array("B", 1), \_ 

         Array("C", 2), Array("D", 3), Array("E", 4), Array("F", 5), \_ 

         Array("G", 6), Array("H", 7), Array("I", 8), Array("J", 9), \_ 

         Array("K", 10), Array("L", 11), Array("M", 12), Array("N", 13), \_ 

         Array("O", 14), Array("P", 15), Array("Q", 16), Array("R", 17), \_ 

         Array("S", 18), Array("T", 19), Array("U", 20), Array("V", 21), \_ 

         Array("W", 22), Array("X", 23), Array("Y", 24), Array("Z", 25))

'tabella dei verifica del carattere di controllo

aCarryTable = Array(Array(0, "A"), Array(1, "B"), Array(2, "C"), Array(3, "D"), _

          Array(4, "E"), Array(5, "F"), Array(6, "G"), Array(7, "H"), \_ 

          Array(8, "I"), Array(9, "J"), Array(10, "K"), Array(11, "L"), \_ 

          Array(12, "M"), Array(13, "N"), Array(14, "O"), Array(15, "P"), \_ 

          Array(16, "Q"), Array(17, "R"), Array(18, "S"), Array(19, "T"), \_ 

          Array(20, "U"), Array(21, "V"), Array(22, "W"), Array(23, "X"), \_ 

          Array(24, "Y"), Array(25, "Z"))

'imposta tutti i caratteri in maiuscolo

sCF = UCase(sCF)

'controllo correttezza sintattica tramite RegEx

vRet = False

Set oRE = CreateObject("vbscript.regexp")

sPatt = "^[A-Z]{6}[0-9]{2}[ABCDEHLMPRST][0-9]{2}A-Z[A-Z]$"

With oRE

.Global = True 

.ignorecase = True 

.Pattern = sPatt 

If .Test(sCF) Then 

    'controllo della correttezza semantica tramite verifica del 16° carattere: 

    'il carattere della tabella aCarryTable, corrispondente al resto della somma 

    'dei valori dei 15 caratteri diviso 26, deve essere uguale al 16 carattere del Codice Fiscale 

    For j = 1 To 15 

        If j Mod 2 = 0 Then 

            'pari 

            aTempTab = aEvenTable 

        Else 

            'dispari 

            aTempTab = aOddTable 

        End If 

        For i = LBound(aTempTab) To UBound(aTempTab) 

            aTemp = aTempTab(i) 

            If Mid(sCF, j, 1) = aTemp(0) Then 

                nHash = nHash + aTemp(1) 

                Exit For 

            End If 

        Next 

    Next 

    nHash = nHash Mod 26 

    aTemp = aCarryTable(nHash) 

    If nHash = aTemp(0) Then 

        If Right(sCF, 1) = aTemp(1) Then 

            vRet = True 

        End If 

    End If 

End If

End With

Set oRE = Nothing

VerificaCodFis = vRet

End Function

Answer 2

Anonimo

Ciao Eleuterio, grazie. Faccio delle prove e vedo come procede.

Ciao, Nicola.

0 commenti

Answer 3

Ciao Eleuterio, ciò che dici è verissimo e concordo a pieno con te.

Ho solo bisogno che la routine mi valuti anche questi nuovi casi di codici fiscali per una mia esigenza lavorativa.

Se questo non è possibile chiudo il trhead e vi ringrazio tantissimo per il vostro aiuto.

Ciao, Nicola.

Answer 4

Eleuterio Tedeschi 18,750 Moderatore volontario

La presenza di tali eccezioni rende l'Agenzia delle Entrate l'unico Ente capace di non rendere falsi positivi.

La presenza di anni ripetuti, omonimie, stranieri ed altro, rende il calcolo del CF ormai obsoleto e non può esserci un risultato affidabile al 100% tramite Excel e questa è la mia opinione, ma a seguito di fatti oggettivi.

Ciao.

0 commenti