Utilizzo VBA al posto della funzione CERCA.VERT ()

Anonimo
2011-07-02T09:56:44+00:00
Il file ANAGRAFICHE.xls è un file esterno alla tabella di ricerca sottostante.
ESTRAZIONE DA FILE ANAGRAFICHE.XLS
es:IN B2 c'è la funzione  =cerca.vert(A2;'C:\Desktop\EROGAZIONI 2011[ANAGRAFICHE.xls)Foglio1!'$A2:E100;1) e così ho esteso anche nelle altre celle la formula.
A B C D E
1 cognome e nome Nato Comune Esenz.Pat. Esenz. IC
2 GATTI ROBERTO 12/05/1965 MILANO SI 00/01/1900 tab. attiva
3 RAGGIO MARIO 13/06/2000 ROMA 00/01/1900 SI con funz. Cerca.vert
4 VERDI GIACOMO 25/04/1984 MILANO 00/01/1900 SI
5 ROSSI UGO 03/02/1950 MILANO 00/01/1900 SI
SU FOGLIO XLS ESTERNO DI NOME :ANAGRAFICHE.XLS
A B C D E
1 cognome e nome Nato Comune Esenz.Pat. Esenz. IC
2 GATTI ROBERTO 12/05/1965 MILANO SI tab.esterna
3 RAGGIO MARIA 13/06/2000 ROMA SI
4 ROSSI MARIO 25/04/1984 TORINO SI SI
5 ROSSI UGO 03/02/1950 MILANO SI
Purtroppo con la funzione cerca.vert(), con cognome e nome simile ma non uguale (vedi Raggio Mario oppure Verdi Giacomo
che non esiste nella tabella esterna "ANAGRAFICHE" , mi tira fuori la data più vicina, invece che dirmi che tale anagrafica non è presente.
Pertanto la tabella di estrazione da un file esterno, non è affidabile e non mi permette di accorgermi dell'errore
Si può fare in VBA Excel 2003 un codice che sostituisca la funzione cerca e quando non trova il nominativo
in luogo del dato più prossimo mi scriva in cella( "Manca anagrafica") ?<br><br><br>Se invece con la correzione della formula CERCA,VERT() si può risolvere il problema, ben venga.<br><br><br>Ho letto un quesito simile, ho cercato di adattarlo ma non ho capito perchè non mi funziona.
Microsoft 365 e Office | Excel | Per la casa | Windows

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 Nessun commento
Risposta accettata dall'autore della domanda
Anonimo
2011-07-15T07:43:18+00:00

Accidenti, oggi ho scoperto che anche le lettere minuscole accentate si possono rendere accentate in maiuscolo senza utilizzare l'apostrofo(apice).

Pensa che non so come si ottiene da tastiera la lettera accentata PATTÈ, l'ho dovuta copiare e incollare altrimenti l'avrei scritta PATTE' come avrebbero fatto in molti.

Quindi, fin qui, tutto OK. interviene sia sulla colonna A del Cognome e anche sulla  C della Residenza.

Ho cercato di scoprire cosa potesse fare il tuo codice riga per riga ma non essendoci un commento ci ho rinunciato, non posso dire che ho fatto un atto di fede perchè ho voluto provarla mettendo blank davanti ... in fondo, mettendo lettere minuscole intercalate a maiuscole e con accenti finali ma funziona alla grande. Direi eccezionale, ma sempre con il tarlo di prendere il pacchetto così com'è.

Pertanto fino qui, OK. Se vuoi darmi in pasto un altro pezzo di codice per proseguire, lo aspetto con ansia.

Intanto commento la parte che immagino risulti *ostica* del codice precedente:

    With sh

        'trovo l'ultima cella con un valore in colonna A

        lRiga = .Range("A" & .Rows.Count).End(xlUp).Row

        'definisco il range con nomi e cognomi

        Set rng = .Range("A2:A" & lRiga)

        'ciclo in range; per ogni cella nel range

        For Each c In rng

            'pulisco le due variabili

            s = ""

            v = ""

            'in c

            With c

                'divido la stringa della cella in tante parti

                'utilizzando lo spazio " " come separatore

                v = Split(.Value, " ")

                'per ogni parte ottenuta

                For lng = 0 To UBound(v)

                    'se la parte è diversa da stringa vuota

                    If v(lng) <> "" Then

                        'aggiungo la parte alla variabile s

                        s = s & v(lng) & " "

                    End If

                Next

                'modifico il valore della cella

                'mettendo tutto maiuscolo la stringa s

                'ed eliminando l'ultimo carattere

                '(nello specifico è uno spazio che so

                'di avere nella stringa)

                .Value = UCase(Mid(s, 1, Len(s) - 1))

                'pulisco le variabili

                s = ""

                v = ""

                'divido la stringa della colonna C

                '(Offset(0,2)

                v = Split(.Offset(0, 2).Value)

                'ripeto quanto fatto per la colonna A

                For lng = 0 To UBound(v)

                    If v(lng) <> "" Then

                        s = s & v(lng) & " "

                    End If

                Next

                .Offset(0, 2).Value = UCase(Mid(s, 1, Len(s) - 1))

            End With

        Next

    End With

Per le accentate, vedi qui: http://www.asciitable.it/asciiext.asp

ALT+0192 ti darà À, ecc.

Vedo di andare avanti... ;-)

La risposta è stata utile?

1 persona ha trovato utile questa risposta.
0 commenti Nessun commento
Risposta accettata dall'autore della domanda
Anonimo
2011-07-15T08:42:11+00:00

 

Vedo di andare avanti... ;-)

... e avanti andiamo.

Questa(che deve essere eseguita *DOPO* aver fatto girare la prima), ti lascierà le righe con Nome/cognome, Data di nascita e residenza *UNIVOCI*. Vuol dire che se Mario Rossi compare tre volte con gli stessi dati, te ne lascia uno solo. Se la data o la residenza di uno dei mario Rossi è diversa, te ne lascierà due:

Public Sub mEliminaDoppi()

    Dim lng As Long

    Dim lRiga As Long

    Dim sh As Worksheet

    Dim lRip As Long

    Set sh = ThisWorkbook.Worksheets("Foglio1")

    Application.ScreenUpdating = False

    With sh

        'trovo l'ultima cella con un valore in colonna A

        lRiga = .Range("A" & .Rows.Count).End(xlUp).Row

        'aggiungo una colonna

        .Range("A:A").Insert Shift:=xlToRight

        'concateno le celle B:D(ho una colonna in più

        'e la residenza è in D)

        .Range("A2").Value = "=CONCATENATE(B2 & C2 & D2)"

        'faccio l'auto completamentio in colonna A

        .Range("A2").AutoFill Destination:=Range("A2:A" & lRiga)

        'ciclo le righe partendo dall'ultima

        For lng = lRiga To 2 Step -1

            'conto quante volte ho la stessa cosa in A

            lRip = Evaluate("=COUNtIF(" & "A2:A" & lRiga & "," & _

                """" & .Range("A" & lng).Value & """" & ")")

            'se ne ho più di una, elimino la riga

            If lRip > 1 Then

                .Rows(lng & ":" & lng).Delete Shift:=xlUp

            End If

        Next

        'elimino la colonna A che non mi serve più

        .Columns("A:A").Delete Shift:=xlToLeft

    End With

    Application.ScreenUpdating = True

    Set sh = Nothing

End Sub

Fai alcune prove su copie del file originale e vedi se va bene nel tuo contesto.

La risposta è stata utile?

0 commenti Nessun commento

39 risposte aggiuntive

Ordina per: Più utili
  1. Anonimo
    2011-07-15T09:23:32+00:00

    Ho provato e funziona a meraviglia, nominativi doppi ma con residenza o data diversa li mantiene altrimenti, se sono identici in tutto ne lascia uno solo.

    Quindi centrato anche questo obiettivo.

    Non so se potrò risponderti subito dopo un altro tuo passaggio perchè dovrò mettermi in viaggio. Non ti nascondo che attendo come già ti dicevo il seguito con desiderio di vedere quello che si riesce a fare in VBA.

    Su piccole cose ci arrivo ma qui per me incomincia ad essere più complesso.

    Dovrò studiarmi le variabili e anche i vari passaggi for e next perchè vedo che è l'abc del VBA.

    La risposta è stata utile?

    0 commenti Nessun commento
  2. Anonimo
    2011-07-15T07:30:41+00:00

    Accidenti, oggi ho scoperto che anche le lettere minuscole accentate si possono rendere accentate in maiuscolo senza utilizzare l'apostrofo(apice).

    Pensa che non so come si ottiene da tastiera la lettera accentata PATTÈ, l'ho dovuta copiare e incollare altrimenti l'avrei scritta PATTE' come avrebbero fatto in molti.

    Quindi, fin qui, tutto OK. interviene sia sulla colonna A del Cognome e anche sulla  C della Residenza.

    Ho cercato di scoprire cosa potesse fare il tuo codice riga per riga ma non essendoci un commento ci ho rinunciato, non posso dire che ho fatto un atto di fede perchè ho voluto provarla mettendo blank davanti ... in fondo, mettendo lettere minuscole intercalate a maiuscole e con accenti finali ma funziona alla grande. Direi eccezionale, ma sempre con il tarlo di prendere il pacchetto così com'è.

    Pertanto fino qui, OK. Se vuoi darmi in pasto un altro pezzo di codice per proseguire, lo aspetto con ansia.

    La risposta è stata utile?

    0 commenti Nessun commento
  3. Anonimo
    2011-07-15T06:45:25+00:00

    Ciao Mauro, da quanto ho visto e provato il tuo codice, la normalizzazione, oltre a pulire i nomi presenti nel file ANAGRAFICHE.xls (FOGLIO1) va oltre le aspettative. Tuttavia, chi scrive (non chiedermi perchè) da sempre utilizza cognomi e nomi con tutti i caratteri maiuscoli. Quindi, bene togliere i blank davanti e in fondo ma i caratteri

    dovranno essere tutti maiuscoli, quindi anche un cognome che ha l'ultima lettera accentata, es. PATTE' la maiuscola finale accentata sarà riconosciuta con l'apice. Quindi, al contrario

    se avrà scritto PATTè questo dovrà diventare PATTE'. (se fosse difficile da trasformare questa eccezione la gestirò a mano).

    Molto probabilmente ti ho depistato in quanto ho scritto per praticità l'esempio con i nomi e cognomi tutii in minuscolo e tu da bravo correttore hai normalizzato nel modo corretto tali cognomi e nomi. Tuttavia ho bisogno che restino maiuscoli.

    Mi servirà comunque in un altro lavoro dove avevo proprio questo problema.

    Spero di aver chiarito i passaggi. Grazie.

     

    Una cosa alla volta. Risolviamo il problema dell'anagrafica.

    Questo codice toglie gli spazi, mette tutto maiuscolo e gestisce gli accenti finali. Controllo anche la Resisdenza, in quanto chi scrive MARIO ROSSI in n modi, può falrlo anche con ASOLI PICENO:

    Public Sub mNormalizza()

        Dim v As Variant

        Dim lng As Long

        Dim s As String

        Dim lRiga As Long

        Dim sh As Worksheet

        Dim c As Range

        Dim rng As Range

        Set sh = ThisWorkbook.Worksheets("Foglio1")

        With sh

            lRiga = .Range("A" & .Rows.Count).End(xlUp).Row

            Set rng = .Range("A2:A" & lRiga)

            For Each c In rng

                s = ""

                v = ""

                With c

                    v = Split(.Value, " ")

                    For lng = 0 To UBound(v)

                        If v(lng) <> "" Then

                            s = s & v(lng) & " "

                        End If

                    Next

                    .Value = UCase(Mid(s, 1, Len(s) - 1))

                    s = ""

                    v = ""

                    v = Split(.Offset(0, 2).Value)

                    For lng = 0 To UBound(v)

                        If v(lng) <> "" Then

                            s = s & v(lng) & " "

                        End If

                    Next

                    .Offset(0, 2).Value = UCase(Mid(s, 1, Len(s) - 1))

                End With

            Next

        End With

        Set sh = Nothing

        Set c = Nothing

        Set rng = Nothing

    End Sub

    La risposta è stata utile?

    0 commenti Nessun commento