![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
Microsoft 365 e Office | Excel | Per la casa | Windows
Una famiglia di software per fogli di calcolo Microsoft con strumenti per l'analisi, la creazione di grafici e la comunicazione dei dati.
Ciao AndyCap64,
ti ringrazio per il tuo supporto è proprio quello che cercavo ti do conferma che non è velocissimo ma è quello che volevo fare.
Ti volevo chiedere solo una cosa potresti descrivermi brevemente come funzionano le variabili create sempre se hai tempo.
grazie mille
vito
Ciao Vito,
non sapendo di preciso quello che vuoi sapere, ti riallego lo stesso codice opportunamente commentato, se, invece, c'è qualcosa di specifico che vuoi sapere chiedi.
Nel codice allegato ho utilizzato Find, con il quale ti eri cimentato senza successo, per spiegarne l'utilizzo.
Come hai tu stesso rilevato, però, non rappresenta la soluzione migliore dal punto di vista della velocità di esecuzione. Dovendo lavorare su grandi quantità di dati, sarebbe opportuno che i campi utilizzati nelle ricerche fossero ordinati così da ottimizzare la procedura.
Ti allego una seconda macro, che utilizza un approccio diverso e che di sicuro ti darà soddisfazioni maggiori.
Un saluto,
Andrea.
Sub cercaFind()
Dim rValue As Range, rTable As Range, cel As Range, rFound As Range
Dim lLastRow1 As Long, lLastRow2 As Long
Application.ScreenUpdating = False
'---------- valori da ricercare
With Worksheets("Foglio1")
'---------- determina ultima riga non vuota in colonna C
lLastRow1 = .Cells(Rows.Count, "c").End(xlUp).Row
'---------- assegna il range contenente i valori da ricercare
Set rValue = .Range("c2:c" & lLastRow1)
End With
'---------- intervallo di ricerca
With Worksheets("Foglio2")
'---------- determina ultima riga non vuota in colonna C
lLastRow2 = .Cells(Rows.Count, "c").End(xlUp).Row
'---------- assegna il range contenente i valori sui quali effettuare la ricerca
Set rTable = .Range("c2:c" & lLastRow2)
End With
'---------- legge un valore alla volta dai valori da ricercare
For Each cel In rValue
'---------- se non è vuoto
If Len(cel.Value) Then
'---------- assegna a rFound la cella di colonna C del Foglio2 che contiene il valore
Set rFound = rTable.Find(cel.Value, rTable.Cells(lLastRow2 - 1, 1), xlValues, xlWhole)
'---------- se ha trovato il valore, copia corrispondente colonna D:E
If Not rFound Is Nothing Then
rFound.Offset(, 1).Resize(, 2).Copy cel.Offset(, 1)
End If
End If
Next
'---------- clen up
Set rTable = Nothing: Set rValue = Nothing
Set rFound = Nothing: Set cel = Nothing
End Sub
Sub cercaMatch()
Dim rTable As Range
Dim vbValue As Variant, vbResult As Variant
Dim i As Long, j As Long, n As Long
On Error Resume Next
Application.ScreenUpdating = False
'---------- copia valori da ricercare in un array in memoria
vbValue = Worksheets("Foglio1").UsedRange.Columns("c").Value
n = UBound(vbValue)
ReDim vbResult(1 To n - 1, 1 To 2)
'---------- asegna intervallo di ricerca
With Worksheets("Foglio2")
'---------- assegna il range contenente i valori sui quali effettuare la ricerca
Set rTable = .Range("c2:c" & .Cells(Rows.Count, "c").End(xlUp).Row)
End With
For i = 2 To n
If Len(vbValue(i, 1)) Then
'---------- utilizza la funzione Confronta(), che restituisce error per trovare il valore
'---------- ma se non lo trova
j = WorksheetFunction.Match(vbValue(i, 1), rTable, 0)
If Err Then
Err.Clear
Else
vbResult(i - 1, 1) = rTable(j, 2)
vbResult(i - 1, 2) = rTable(j, 3)
End If
End If
Next
'---------- incolla i valori trovati sul foglio di lavoro
Worksheets("Foglio1").Cells(2, 4).Resize(n, 2).Value = vbResult
Set rTable = Nothing
End Sub