Domanda:
Come ovviare al problema che CERCA.VERT() si ferma al primo dato ricercato e trascura gli altri duplicati, chiaramaente duplicati solo nella colonna di ricerca ma nelle altre di cui rileverne i dati?

Risposta:

La soluzione a questo problema era stata già affronata da Andrea nell’articolo presente al link
http://www.terzaghi.it/excel/cercanesimo.htm
Andrea ha creato la funzione “NLookUp” per il cui funzionamento vi invito a leggere l’articolo,
io ho pensato di rendere più dinamica la sua funzione valorizzandone automaticamente i parametri che richiede.

Dopo aver pulito la tabella dove la macro riporterà i valori della funzione Nlookup,
copio la colonna che contiene i valori da cercare e rimuovo i duplicati

Sheet1.Range(Cells(1, 1), Cells(Last_Row_a, 1)).Select
 Selection.Copy

Sheet1.Cells(1, First_Col_TabRiepilogo).Select
 ActiveSheet.Paste
 Application.CutCopyMode = False

ActiveSheet.Range(Cells(1, First_Col_TabRiepilogo), Cells(
Last_Row_a, First_Col_TabRiepilogo)).RemoveDuplicates Columns:=1, Header:=xlYes

I nomi così filtrati popoleranno il parametro “Valore” (rispetto alla funzione originale il parametro è di tipo Variant al posto di Long)

Per ciascun nome, calcolo il numero di occorrenze (volte in cui il nome viene ripetuto) attraverso un Conta.Se (CountIF):

For i = 2 To Last_Row_f
    Sheet1.Cells(i, First_Col_TabRiepilogo + 1) = Application.WorksheetFunction.CountIf(RangeOrigine, Sheet1.Cells(i, First_Col_TabRiepilogo))
Next i

Calcolo a questo punto il numero massimo di occorrenze per poter creare o eliminare le colonne della Tabella Riepilogo:

MaxOccorrenze = Application.WorksheetFunction.Max(Columns(First_Col_TabRiepilogo + 1))

Il parametro “Dove” è valorizzato all’inizione della macro con:

Last_Row_a = Sheet1.Range("A1").End(xlDown).Row
Dim RangeOrigine As Range
Set RangeOrigine = Sheet1.Range(Cells(1, 1), Cells(Last_Row_a, 2))

A questo punto con due cicli For-Next, uno per le righe che contengono i nomi,

l’altro per tante colonne quante sono le occorenze massime possibili

applico la funzione NLookup:

Sheet1.Cells(i, y) = NLookup(RangeOrigine, Sheet1.Cells(i, First_Col_TabRiepilogo), Occorrenza, 0, 1)

A voi il file:
APRI

Riccardo Vincenti

The following two tabs change content below.

• Bio
• Ultimi Post

Riccardo Vincenti

Ultimi post di Riccardo Vincenti (vedi tutti)

• 073. Duplicare righe excel modificando il contenuto - 6 Ottobre 2017
• 072. Estrazione numeri casuali - 6 Ottobre 2017
• 071. Estrazione casuale valori da un elenco - 5 Ottobre 2017
• 070. Contare dati univoci senza Pivot - 21 Settembre 2017
• 069. Aggiungere intervalli ad una data: Date Add in Excel - 21 Settembre 2017

This work by Riccardo Vincenti is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International