Individuazione dei Codici Fiscali in comune nei Report P05 con Macro “Trova Codici Fiscali Comuni”

Per individuare i codici fiscali presenti contemporaneamente nei P05 di Impiegati, Dirigenti, Collaboratori e Borsisti, utilizza la macro Excel “Trova Codici Fiscali Comuni”.

Segui questi passaggi:

  1. Esegui il report personalizzato URPT_P05_FISCALE separatamente per ciascuna categoria: Impiegati, Dirigenti, Collaboratori e Borsisti.

  2. Inserisci i quattro report ottenuti in un unico file Excel, ciascuno su un foglio diverso.

  3. Avvia la macro “EstraiCodiciComuniConAssCess” vai qui

La macro creerà un nuovo foglio contenente l’elenco dei codici fiscali presenti in almeno due dei report analizzati. Nell’ultima colonna a destra verrà riportata la qualifica di appartenenza, indicando chiaramente da quali report provengono le informazioni relative a ciascun codice fiscale.


Macro:

Sub TrovaCodiciFiscaliComuni()

    Dim ws As Worksheet, wsOutput As Worksheet

    Dim dict As Object, codiciFiscali As Object

    Dim lastRow As Long, colCF As Long

    Dim i As Long, j As Long, key As Variant

    Dim codice As String

    Dim outputRow As Long

    Dim wb As Workbook


    Set wb = ActiveWorkbook ' ? Usa il file attivo, NON quello in cui sta la macro

    Set dict = CreateObject("Scripting.Dictionary")

    Set codiciFiscali = CreateObject("Scripting.Dictionary")


    ' 1. Raccoglie tutti i codici fiscali presenti nei fogli

    For Each ws In wb.Worksheets

        If ws.Name <> "CodiciComuni" Then

            colCF = TrovaColonnaCodiceFiscale(ws)

            If colCF = 0 Then GoTo SkipSheet1


            lastRow = ws.Cells(ws.Rows.Count, colCF).End(xlUp).Row

            For i = 2 To lastRow

                codice = Trim(ws.Cells(i, colCF).Value)

                If codice <> "" Then

                    If Not dict.exists(codice) Then

                        Set dict(codice) = CreateObject("Scripting.Dictionary")

                    End If

                    dict(codice)(ws.Name) = True

                End If

            Next i

        End If

SkipSheet1:

    Next ws


    ' 2. Seleziona codici presenti in almeno 2 fogli

    For Each key In dict.Keys

        If dict(key).Count >= 2 Then

            codiciFiscali(key) = True

        End If

    Next key


    ' 3. Crea foglio di output

    Application.DisplayAlerts = False

    On Error Resume Next

    wb.Sheets("CodiciComuni").Delete

    On Error GoTo 0

    Application.DisplayAlerts = True


    Set wsOutput = wb.Sheets.Add

    wsOutput.Name = "CodiciComuni"

    outputRow = 1


    ' 4. Copia righe con CF comuni

    For Each ws In wb.Worksheets

        If ws.Name <> "CodiciComuni" Then

            colCF = TrovaColonnaCodiceFiscale(ws)

            If colCF = 0 Then GoTo SkipSheet2


            lastRow = ws.Cells(ws.Rows.Count, colCF).End(xlUp).Row


            If outputRow = 1 Then

                ws.Rows(1).Copy Destination:=wsOutput.Rows(outputRow)

                wsOutput.Cells(outputRow, ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column + 1).Value = "FOGLIO_ORIGINE"

                outputRow = outputRow + 1

            End If


            For i = 2 To lastRow

                codice = Trim(ws.Cells(i, colCF).Value)

                If codiciFiscali.exists(codice) Then

                    ws.Rows(i).Copy Destination:=wsOutput.Rows(outputRow)

                    wsOutput.Cells(outputRow, ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column + 1).Value = ws.Name

                    outputRow = outputRow + 1

                End If

            Next i

        End If

SkipSheet2:

    Next ws


    MsgBox "Macro completata! Foglio 'CodiciComuni' creato.", vbInformation

End Sub


Function TrovaColonnaCodiceFiscale(ws As Worksheet) As Long

    Dim j As Long, testo As String

    For j = 1 To ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

        testo = UCase(Trim(Replace(Replace(ws.Cells(1, j).Value, "_", ""), "-", "")))

        If testo Like "*CODICEFISCALE*" Then

            TrovaColonnaCodiceFiscale = j

            Exit Function

        End If

    Next j

    TrovaColonnaCodiceFiscale = 0

End Function