Codice fiscale con excel vba

Hai un problema con Excel?

Nuova discussione

Codice fiscale
di R (utente non iscritto) data: 12/02/2009
Sul blog ho inserito una formula per la verifica del formato del codice fiscale.
utilizo le espressioni regolari, se volete capirne di più, per domande o altro sono a disposizione per parlarne.
saluti
r
di Mauro (utente non iscritto) data: 13/02/2009
Grande "r"! hai fatto un ottimo lavoro! invito tutti coloro che hanno seguito un progetto o hanno fatto una esperienza con excel e vba a condividerla nel blog.

di Enzo (utente non iscritto) data: 13/02/2009
Ciao roberto, ho visto sul blog l'argomento relativo al codice fiscale e l'ho trovato interessante anche per quello che vorrei chiederti
ossia tempo fa ho creato questa macro che avendo i codici ficali nella colonna a di un foglio estrae il codice relativo al luogo di nascita, controlla in un database posto in un altro foglio e restituisce al fianco di ogni codice fiscale il luogo e la provincia di nascita
premetto che la macro funziona bene
l'unica pecca e' che avendo l'esigenza al lavoro di controllare una molteciplita' di codici fiscali la macro risulta essere lenta
tu hai un consiglio per avere qualcosa che sia piu' snella?

ps ho visto che hai affrontato il discorso dei codici a barre
se puo' esserti di aiuto per implementare qualcosa prova a dare un occhiata a questo sito francese

grandzebu.net/index.php

Range("H1").Select
ActiveCell.FormulaR1C1 = "=NOW()"
INIZIO = ActiveCell.Text
ActiveCell.Value = ""
Columns("B:C").Select
Selection.ClearContents
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 10).Select
ActiveCell.FormulaR1C1 = "=ROW()"
RIGA = ActiveCell.Value + 1
ActiveCell.Value = ""
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "NUM"
Range("B1").Select
ActiveCell.FormulaR1C1 = "CF"
Range("C1").Select
ActiveCell.FormulaR1C1 = "COD"
Range("C2").Select
W = 1
For i = 2 To RIGA
Range("A" & i).Select
ActiveCell.Value = W
Let W = W + 1
Next i
For i = 2 To RIGA
lunghezza = Len(Range("B" & i))
If lunghezza = 16 Then
ESTRATTO = Mid(Range("B" & i), 12, 4)
Range("C" & i).Value = ESTRATTO
End If
Next i
 Range("A1").Select
    Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 Columns("C:C").Select
    Selection.ClearContents
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "COD"
For i = 2 To RIGA
For H = 1 To 8424
lunghezza = Len(Range("B" & i))
If lunghezza = 16 Then
ESTRATTO = Mid(Range("B" & i), 12, 4)
If ESTRATTO = Foglio4.Range("A" & H).Value Then
Range("C" & i).Value = Foglio4.Range("B" & H).Value
Range("D" & i).Value = Foglio4.Range("C" & H).Value
GoTo 10
End If
End If
Next H
10 Next i
  Range("A1").Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
Range("H1").Select
ActiveCell.FormulaR1C1 = "=NOW()"
FINE = ActiveCell.Text
ActiveCell.Value = ""
Application.ScreenUpdating = True
MsgBox "INIZIO CALCOLO ORE " & INIZIO & " FINE CALCOLO ORE " & FINE
Range("A1").Select

di R (utente non iscritto) data: 13/02/2009
Ciao mauro,
grazie per i complimenti, ti ho mandato una mail dagli un occhio e fai sapere.

ciao enzo,
se vuoi posso postarti una routine che dati un foglio che in colonna a ha l'elenco dei codici fiscali e in un altro foglio ha l'elenco dei codici catastali in colonna a in colonna b le località e in colonna c la provincia assegna ad ogni codice fiscale in colonna b e c le località e le province ... onestamente nella tua routine non metterei le mani anche perchè esegue operazioni di sistemazione troppo personalizzate e quindi dovrei vedere il file per darti una risposta su come migliorarla ... intento come già da me detto numerose volte le istruzioi di select e activate sono normalmente evitabili e sconsigliabili.
fai sapere
ciao
r
di Enzo (utente non iscritto) data: 13/02/2009
Ciao r, e' quello che volevo poi penso io ad adattarla

di R (utente non iscritto) data: 13/02/2009
Ciao enzo, non l'ho testata molto ma sembra che funzioni correttamente, adatta i range
verrà creato un nuovo foglio con i risultati, io l'ho testata con circa 3000 codici fiscali e 8000 comuni impiega pochi secondi ...
fai sapere
ciao
r

Sub Aggiungi_Loc_a_CF()
    
Dim L1 As Long, L2 As Long, L3 As Long, L4 As Long
Dim S1 As String, S2 As String
Dim Rng1 As Excel.Range
Dim Rng2 As Excel.Range
Dim arr1() As Variant
Dim arr2() As Variant
Dim arrR() As Variant

Set Rng1 = [foglio1!a1] '< 1 Then Exit Sub
If Rng2.Count > 1 Then Exit Sub

L1 = UltimaRiga(, Rng1.EntireColumn)
L2 = UltimaRiga(, Rng2.EntireColumn)

Set Rng1 = Rng1.Resize(L1 - Rng1.Row + 1)
Set Rng2 = Rng2.Resize(L2 - Rng2.Row + 1, 3)
    
arr1 = Rng1.Value
arr2 = Rng2.Value

L2 = UBound(arr1, 1)
L4 = UBound(arr2, 1)
ReDim arrR(1 To UBound(arr1), 1 To 3)

For L1 = 1 To L2
    S1 = arr1(L1, 1)
    S2 = Mid(S1, 13, 3)
    arrR(L1, 1) = S1
    For L3 = 1 To L4
        If S2 = arr2(L3, 1) Then
            arrR(L1, 2) = arr2(L3, 2)
            arrR(L1, 3) = arr2(L3, 3)
            Exit For
        End If
    Next L3
Next L1
            
Set Rng2 = ThisWorkbook.Worksheets.Add().Range("A1")
Set Rng2 = Rng2.Resize(L1 - 1, 3)
Rng2.Value = arrR
End Sub


Function UltimaRiga(Optional sh As Worksheet, _
                 Optional Rng As Range) As Long

'By Norman Jones modificata restituisce
'l'ultima riga valorizzata
'restituisce 0 se il foglio è pulito
'passando Sh verrà ignorato Rng
'passando Rng verrà ignorato Sh
'non passando argomenti verrà ricercata
'l'ultima riga valorizzata del foglio
'attivo
'utilizzata come UDF è consigliabile
'passare Rng
    
    If sh Is Nothing Then
        If Rng Is Nothing Then
            Set Rng = [a1].Parent.UsedRange
        End If
    Else
        Set Rng = sh.UsedRange
    End If
    
    On Error Resume Next
    UltimaRiga = Rng.Find(What:="*", _
                       After:=Rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
    On Error GoTo 0
End Function

di Enzo (utente non iscritto) data: 16/02/2009
Ciao roberto
grazie inizialmente
ho utilizzato le tue istruzioni
come hai detto tu, ho un foglio dove in colonna a
ho i codici fiscali
poi ho un altro foglio che ho chiamato database dove ho tutti i comuni d'italia cosi suddivisi colonna a codice (es f839) colonna b il comune (napoli) colonna c la provincia (na)
il problema e' che appena parte mi si impianta nell'istruzione qui sotto e guardando quello che mi hai inviato non riesco ad adattarlo
potresti postarmi un foglio excel con un esempio
If Rng2.Count > 1 Then Exit Sub
di Enzo (utente non iscritto) data: 16/02/2009
Poi non ho capito cosa centra la funzione che mi hai inviato "ultima riga"
non la utilizzo da nessuna parte

di R (utente non iscritto) data: 16/02/2009
Si era mangiato un pezzo ... rng1 è la prima cella in alto che contiene un codice fiscale, mentre rng2 è la prima cella in alto che contiene il codice catastale ... adatta poi foglio1 e foglio2
fai sapere
ciao
r

Sub Aggiungi_Loc_a_CF()
    
Dim L1 As Long, L2 As Long, L3 As Long, L4 As Long
Dim S1 As String, S2 As String
Dim Rng1 As Excel.Range
Dim Rng2 As Excel.Range
Dim arr1() As Variant
Dim arr2() As Variant
Dim arrR() As Variant

Set Rng1 = [foglio1!a1] 'prima cella con CF
If Rng1.Count > 1 Then Exit Sub
Set Rng2 = [foglio2!a1] 'prima cella con Codice città
If Rng2.Count > 1 Then Exit Sub

L1 = UltimaRiga(, Rng1.EntireColumn)
L2 = UltimaRiga(, Rng2.EntireColumn)

Set Rng1 = Rng1.Resize(L1 - Rng1.Row + 1)
Set Rng2 = Rng2.Resize(L2 - Rng2.Row + 1, 3)
    
arr1 = Rng1.Value
arr2 = Rng2.Value

L2 = UBound(arr1, 1)
L4 = UBound(arr2, 1)
ReDim arrR(1 To UBound(arr1), 1 To 3)

For L1 = 1 To L2
    S1 = arr1(L1, 1)
    S2 = Mid(S1, 13, 3)
    arrR(L1, 1) = S1
    For L3 = 1 To L4
        If S2 = arr2(L3, 1) Then
            arrR(L1, 2) = arr2(L3, 2)
            arrR(L1, 3) = arr2(L3, 3)
            Exit For
        End If
    Next L3
Next L1
            
Set Rng2 = ThisWorkbook.Worksheets.Add().Range("A1")
Set Rng2 = Rng2.Resize(L1 - 1, 3)
Rng2.Value = arrR
End Sub


Function UltimaRiga(Optional sh As Worksheet, _
                 Optional Rng As Range) As Long

'By Norman Jones modificata restituisce
'l'ultima riga valorizzata
'restituisce 0 se il foglio è pulito
'passando Sh verrà ignorato Rng
'passando Rng verrà ignorato Sh
'non passando argomenti verrà ricercata
'l'ultima riga valorizzata del foglio
'attivo
'utilizzata come UDF è consigliabile
'passare Rng
    
    If sh Is Nothing Then
        If Rng Is Nothing Then
            Set Rng = [a1].Parent.UsedRange
        End If
    Else
        Set Rng = sh.UsedRange
    End If
    
    On Error Resume Next
    UltimaRiga = Rng.Find(What:="*", _
                       After:=Rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
    On Error GoTo 0
End Function

di Enzo (utente non iscritto) data: 17/02/2009
Ciao r l'istruzione funziona
solo che per farlo funzionare ho dovuto modificare l'istruzione che ti ho inserito qui sotto (e' gia' quella modificata") in quanto quella precedentemente postata estraeva dal codice fiscale solo la parte numerica e non anche la lettera corrispondente
es. napoli f839 estraeva solo 839
avrei due quesiti da sottoporti
l'istruzione completa inserisce un nuovo foglio e mi reinserisce il codice fiscale il comune e la provincia
se volessi inserire solo il comune e la provincia ma nel foglio dove vengono presi i codici fiscali (foglio1 per capirci) dove devo intervenire?
secondo quesito - come mai se ho solo un codice fiscale lui si impianta
S2 = Mid(S1, 12, 4)
di Enzo (utente non iscritto) data: 17/02/2009
Ciao r
non tener conto del primo quesito perche' ho risolto
mi serve solo sapere perche' si impianta su un codice fiscale
di Enzo (utente non iscritto) data: 17/02/2009
Roberto volevo chiederti un altra cosa circa un lavoro interessante che avevi postato sul blog relativo alla rimozione di password da celle e cartelle di un foglio excel
c'e' la possibilita' di rimuovere la password da un progetto vba
tempo fa avevo creato un lavoro carino in excel ma non mi ricordo piu' la password del progetto
di R (utente non iscritto) data: 17/02/2009
Se apri il file con openoffice riesci a vedere il codice vba.
open office lo puoi scaricare gratuitamente.
ciao
r
di R (utente non iscritto) data: 19/02/2009
Ciao enzo,
puoi allungarmi il database che usi per risalire al comune e provincia e con i codici del tipo e379 (ivrea torino)
il mio indirizzo mail è robb.menchiocciolagmail.com
grazie 1000
saluti
r
di Enzo (utente non iscritto) data: 19/02/2009
Fatto fa sapere
ciao

Vuoi Approfondire?