Ricerca per nome e cognome

Hai un problema con Excel?

Nuova discussione

Ricerca per nome e cognome
di Epicur8 data: 21/10/2015 21:45:50
Salve a tutti, mi sono appena iscritto per risolvere un problema personalmente complicato.
Di Excel ho una buona conoscenza, mentre di VBA abbastanza rudimentale.

Vi spiego in breve la situazione...

Mi ritrovo due elenchi:
Il primo ha le seguenti colonne:
Nome_Cognome; Cognome; Nome; indirizzo email

Il secondo ha queste colonne:
Nome_Cognome; Cognome; Nome

Devo trovare nel primo elenco l'indirizzo email delle persone presenti nel secondo elenco.

Detto così sembra abbastanza semplice, se il Nome_Cognome del secondo elenco è scritto allo stesso modo di quello del primo elenco basterebbe un Cerca.vert

Il problema è che il primo elenco è stato compilato male, nomi e cognomi a volte sono invertiti, e ci sono brasiliani e portoghesi che hanno nomi lunghi che vengono abbreviati, oppure nei cognomi e nei nomi ci sono degli errori di battitura. Alcuni nomi presentano più nomi insieme (tipo Francesco Maria). Considerate inoltre che si parla di migliaia di persone, e che alcune persone del primo elenco non sono presenti nel secondo, e viceversa... insomma una bella gatta da pelare.

Mi sono mosso prima ordinando tutto in ordine alfabetico, poi scomponendo i cognomi composti da più parole in più colonne tramite "testo in colonne" (stessa cosa per i nomi) sia per il primo che per il secondo elenco.
Successivamente nel secondo elenco ho creato una colonna in cui, tramite la funzione confronta, mi va a cercare la prima riga in cui si trova il cognome che vado a cercare, e a fianco una colonna in cui mi dice l'ultima riga in cui si trova il cognome: facendo così ho in due colonne l'intervallo in cui effettuare la ricerca.
Infine nella colonna a fianco un'altra funzione confronta che mi individua la riga esatta (nome+cognome).

Così facendo però, vista la varietà di scenari (di errori e disposizione delle stringhe), mi trovo costretto a creare una colonna per ciascun scenario (ad esempio una colonna che mi va a cercare la riga nel caso in cui nome e cognome siano invertiti), che si attiva solo se le analisi precedenti non sono state in grado di individuare la riga esatta. Per non parlare poi del problema di individuare nomi e cognomi scritti con errori

Immaginate il casino che ne risulta, e di conseguenza l'aumento di probabilità di errori nella ricerca.

A questo punto, visto che facendo così per ogni problema che risolvo rischio di crearne un altro, sto pensando di utilizzare una macro.
Finora però ho sempre utilizzato VBA per fare operazioni molto semplici, qui si tratta di analizzare tante stringhe in diversi modi, e non ho la competenza necessaria.

Pensavo a un comando che prendesse ogni singolo record (Nome_Cognome;Nome;Cognome), disponesse i dati in una riga e rimuovesse i duplicati e quindi iniziasse a fare la ricerca tra i vari record, di quelli che avessero un numero variabile di stringhe e offrisse all'operatore una cerchia limitata di record dai quali può scegliere manualmente il record (la persona) desiderata.

Ad esempio, voglio cercare il seguente record (presente nel secondo elenco), tra quelli del primo

Garibaldi Francesco Maria Antonio (Nome_Cognome); Garibaldi Rizzo (Cognome); Francesco Antonio (Nome)

notate bene come nel Nome_Cognome non è presente Rizzo (presente nel Cognome), ma è presente Maria (che non c'è nel Nome)

Disponendo tutte le stringhe consequenzialmente mi risulterà

Garibaldi Rizzo Francesco Maria Antonio

A questo punto inizierà la ricerca nel primo elenco e mi tirerà fuori i seguenti record (da selezionare nella Userform):

Garibaldi Francesco Maria
Rizzo Francesco
Garibaldi Maria
Rizzo Antonio

A questo punto l'operatore intuirà che sarà il primo record quello desiderato, lo seleziona e quindi l'analisi proseguirà nel secondo record del secondo registro

ora farà la ricerca su questo record

Gaber Giorgio (Nome_Cognome); Gaber (Cognome); Giorgio (Nome)

e troverà solo questo record

Gaber Giorgio

non chiederà conferma visto che il match è più che sicuro

e passerà al terzo record e così via

Ritenete sia una soluzione adatta?

Siccome non posso pubblicare gli elenchi, dato che sono dati personali, vi chiedo per ora una vostra opinione, o un consiglio sul modo in cui mi dovrei muovermi.
di patel data: 22/10/2015 07:52:16
potresti allegare un file di esempio con nomi inventati ma significativo per i problemi che descrivi, altrimenti è difficile capire
di Epicur8 data: 22/10/2015 20:25:15
Ciao patel, ho allegato un file di esempio, con alcuni nomi volutamente invertiti o errati

di Epicur8 data: 24/10/2015 14:31:48
ciao rieccomi qui,
in questi due giorni ho provato a scrivere il codice che dovrebbe fare il lavoro richiesto. L'ho allegato alla discussione con il nome "ricerca nomecognome3".

Per ora mi accontento di individuare solo i casi di nomi e cognomi invertiti.

Tuttavia nel momento in cui provo a fare partire il commandbutton1 presente nella userform1 (si avvia solo tramite VBA), mi segnala il seguente errore:

"Errore di compilazione. Necessario oggetto"

relativo alla seguente riga:

Set eRow = trova.Cells(1, 8).End(xlDown).Offset(1).Row

Eppure mi sembra di aver già definito la variabile eRow come Long, e trova come Worksheets... quindi qualcosa mi può essere sfuggito ma non riesco a capire cosa

Vi lascio il codice per intero

Private Sub CommandButton1_Click()
Dim iRow As Long
Dim eRow As Long
Dim trova, cerca, confronta, calcolo As Worksheet
Dim continueValue As Integer
Dim stopValue As Integer
Dim changeValue As Integer

Set trova = Worksheets("Elenco1")
Set cerca = Worksheets("Elenco2")
Set calcolo = Worksheets("Calcolo")
Set confronta = Worksheets("Comparison")
' nel codice sottostante mi segnala errore
Set eRow = trova.Cells(1, 8).End(xlDown).Offset(1).Row
Set iRow = cerca.Cells(1, 4).End(xlDown).Offset(1).Row

'qui mi si attiva un ciclo loop, che continua ad operare finché non è stata effettuata la ricerca per tutti i record dell'Elenco2

Do While calcolo.Cells(1, 12).Value = 0
 
' e qui mi avvia un secondo ciclo loop nidificato che continua finché per ogni record dell'elenco 2 ha effettuato il confronto in tutti i record dell'elenco 1
Do While calcolo.Cells(1, 11).Value = 0

cerca.Select
Range(Cells(iRow, 1), Cells(iRow, 3)).Select

Selection.Copy

confronta.Select

Range(Cells(2, 1), Cells(2, 3)).Select

Selection.PasteSpecial Paste:=xlPasteValues

Set rigaVer = confronta.Range("A2:C2")

Set nOcO = Cells(4, 1)

Set NO = Cells(4, 2)

Set cO = Cells(4, 3)

'nome_cognome, nome e cognome vengono separati e disposti in colonna

rigaVer.Select

Selection.Copy
rigaVer.Select
Application.CutCopyMode = False
Selection.Copy
nOcO.Select
Selection.PasteSpecial Transpose:=True
Application.CutCopyMode = False
Selection.TextToColumns Destination:=nOcO, DataType:=xlDelimited, ConsecutiveDelimiter:=True, Tab:=False, Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

NO.Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
nOcO.Select
Selection.End(xlDown).Select
Range("A7").Select
Selection.PasteSpecial Transpose:=True
Range("A8").Select
Selection.End(xlUp).Select
NO.Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.ClearContents
Range("B5").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Range("A5").Select
Selection.End(xlDown).Select
Range("A9").Select
Selection.PasteSpecial Transpose:=True
Range("A5").Select
Selection.End(xlUp).Select
Range("B5").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A5").Select
Selection.End(xlUp).Select
Range("B6").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Range("A6").Select
Selection.End(xlDown).Select
Range("A9").Select
Selection.PasteSpecial Transpose:=True
Application.CutCopyMode = False
Selection.End(xlUp).Select
Range("B6").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
Range("A6").Select

'ora vengono rimossi i duplicati
Range(nOcO, Cells(999, 1)).RemoveDuplicates Columns:=1, Header:=xlNo
Dim Intervallo As Range
Dim Righe, R
Set Intervallo = Range(nOcO, Cells(999, 1))

'viene individuata la prima scheda dell'intervallo con le email da confrontare
trova.Select
Range(Cells(eRow, 3), Cells(eRow, 5)).Select
Selection.Copy
confronta.Select
Range(Cells(2, 8), Cells(2, 10)).Select
Selection.PasteSpecial Paste:=xlPasteValues
Set rigaVer2 = confronta.Range("H2:J2")
Set nOcO2 = Cells(4, 8)
Set nO2 = Cells(4, 9)
Set cO2 = Cells(4, 10)

'spostate nelle colonne
rigaVer2.Select
Selection.Copy
rigaVer2.Select
Application.CutCopyMode = False
Selection.Copy
nOcO2.Select
Selection.PasteSpecial Paste:=xlPasteAll, Transpose:=True
Application.CutCopyMode = False
nOcO2.Select
Selection.TextToColumns Destination:=nOcO2, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
nO2.Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
nOcO2.Select
Selection.End(xlDown).Select
Range("H7").Select
Selection.PasteSpecial Transpose:=True
Range("H8").Select
Selection.End(xlUp).Select
nO2.Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.ClearContents
Range("I5").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Range("H5").Select
Selection.End(xlDown).Select
Range("H9").Select
Selection.PasteSpecial Transpose:=True
Range("H5").Select
Selection.End(xlUp).Select
Range("I5").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.ClearContents
Range("H5").Select
Selection.End(xlUp).Select
Range("I6").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Range("H6").Select
Selection.End(xlDown).Select
Range("H9").Select
Selection.PasteSpecial Transpose:=True
Application.CutCopyMode = False
Selection.End(xlUp).Select
Range("I6").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
Range("H6").Select

'ora vengono rimossi i duplicati
Range(nOcO2, Cells(999, 8)).RemoveDuplicates Columns:=1, Header:=xlNo

Dim Intervallo2 As Range
Set Intervallo2 = Range(nOcO2, Cells(999, 8))
If Cells(5, 12).Value > "0,85" Then
confronta.Cells(2, 12).Select
Selection.Copy
cerca.Cells(confronta.Cells(2, 4).Value, 4).Select
Selection.PasteSpecial Transpose:=True
Exit Do
Else
cerca.Cells(confronta.Cells(1, 4).Value, 4).Value = NO
End If
    
eRow = eRow + 1
Loop
iRow = iRow + 1
Loop
End Sub

di Albatros54 data: 24/10/2015 15:56:33
Forse è meglio!!

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

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

di Marius44 data: 24/10/2015 17:17:27
@albatros
Ciao Gioacchino, ci avevo già provato ma non funziona perché il ciclo non è impostato su For .. Next e, quindi dalla cella 2 alla cella Ultima. Come suggerisci tu inizierebbe dall'ultima che, alla fine del ciclo, incrementa di 1.
Debbo dire che il codice è molto ingarbugliato e non capisco come possa funzionare se all'inizio pone questi due cicli
Do While calcolo.Cells(1, 12).Value = 0
Do While calcolo.Cells(1, 11).Value = 0
senza che i valori delle celle relative vengano mai incrementati o diminuiti.
Ci sto lavorando da qualche ora ed ho ottenuto qualche giro facendo questo:
eRow = 2: iRow = 2 e ponendo i due loop suddetti a <> 0
e mi si blocca, per un errore non gestito, qui:
cerca.Cells(confronta.Cells(1, 4).Value, 4).Value = NO

Adesso sto uscendo. Vediamo domani (se ho tempo).

@Epicur
Guarda che, comunque, il codice è da ripulire (ed anche molto).

Ciao,
Mario

di Epicur8 data: 25/10/2015 00:45:19
La correzione di Albatros è riuscita a correggere l'errore, l'ho modificata facendo riferimento alle colonne di mio interesse

eRow = trova.Range("H" & Rows.Count).End(xlUp).Offset(1).Row
iRow = cerca.Range("D" & Rows.Count).End(xlUp).Offset(1).Row

Hai ragione Marius, infatti cambiando il Do While con un Do Until il processo si avvia e provvede ad analizzare tutte i record dell'Elenco1 finché non arriva all'ultima riga vuota, interrompendomi il processo con un errore.

A questo punto devo provvedere a correggere il codice mettendo la condizione che se la selezione arriva all'ultima riga dell'Elenco1 deve interrompere la ricerca di ulteriori registri nell'Elenco1 e di conseguenza procedere a una nuova ricerca con la voce successiva dell'Elenco2

Inoltre, nonostante abbia inserito la condizione per cui se si riesce a trovare un match di stringhe tra le due voci (una dell'Elenco1 e l'altra dell'Elenco2) automaticamente provvede a inserire nella colonna 4 dell'elenco due il numero di riga del record "matchato" dell'elenco 1, e quindi a provvedere alla ricerca del record successivo dell'Elenco2, ciò non avviene (la parte del codice ve la riporto). Sicuramente ci sono ancora degli errori (e non pochi )

Riguardo la necessità di pulizia del codice non posso non darti ragione Marius, parte del codice l'ho "scritto" copiando e incollando il codice scritto da una macro (di preciso quella che separa in colonne le singole stringhe separate da spazi delle voci Nome_Cognome, Nome e Cognome, poi le traspone in un'unica colonna e poi rimuove i duplicati)

If confronta.Cells(5, 12).Value > "0,85" Then

    confronta.Cells(2, 12).Select

    Selection.Copy

   

    cerca.Cells(confronta.Cells(2, 4).Value, 4).Select

    Selection.PasteSpecial Transpose:=True

        Exit Do

       

Else
Dim bUR As Long

   bUR = confronta.Cells(1, 4).Value
   

cerca.Cells(bUR & "4").Value = NO

 

End If

di Epicur8 data: 25/10/2015 14:45:58
Tra questa notte e stamattina ho messo mano sul file e dopo vari tentativi (spesso alla cieca) ora il codice fa il suo lavoro. :)
Vi allego il fine nomecognome5

Adesso la priorità è fare un po' di pulizia, devo capire bene come si possa fare tramite VBA la separazione del testo in colonne e la trasposizione senza utilizzare tutto questo codice.
Nel frattempo che faccio un po' di approfondimento, voi che scorciatoie utilizzereste?

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False

Selection.TextToColumns Destination:=nOcO, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
NO.Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
nOcO.Select
Selection.End(xlDown).Select
Range("A7").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range("A8").Select
Selection.End(xlUp).Select
NO.Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.ClearContents
Range("B5").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Range("A5").Select
Selection.End(xlDown).Select
Range("A9").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range("A5").Select
Selection.End(xlUp).Select
Range("B5").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A5").Select
Selection.End(xlUp).Select
Range("B6").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Range("A6").Select
Selection.End(xlDown).Select
Range("A9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Selection.End(xlUp).Select
Range("B6").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
Range("A6").Select

di Marius44 data: 25/10/2015 17:19:48
Ciao Epicur
Solo adesso mi son rimesso al PC ed ho visto l'ultimo file che hai allegato: sembra faccia quello che vuoi. Come detto ieri il codice (che potrebbe andare anche così) ha bisogno, a mio avviso, di essere snellito; però è molto lento.
Tutti quei Select, Copy, Paste ... appesantiscono.
Permettimi un suggerimento: invece di selezionare, copiare, confrontare e incollare prova ad assegnare gli elenchi a delle Array, fai il confronto fra i termini delle Array e scrivi solo il risultato.
Comunque hai fatto un buon lavoro. Complimenti.
Ciao,
Mario

Vuoi Approfondire?