![](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 a tutti,
utilizzo una funzione trovata sulla rete che cerca e restituisce piu' valori concatenati sulla stessa riga.
Ho fatto una prova su un pentium 4 e dopo circa 2 ore ho ottenuto il risultato atteso.
Vi chiedo se e' possibile velocizzare i risultati ottenuti da parte della function --> vedi foglio "output".
Grazie a tutti,
A.
Ciao Antonino69,
dal foglio allegato non riesco a vedere come utilizzi la funzione, anche se credo di aver compreso le tue necessità.
La causa principale della lentezza della tua funzione, è da imputare ai continui accessi al foglio di lavoro da parte del codice VBA. Molto meglio caricare tutti i dati che servono in memoria e lavorare su questi. E' molto più veloce!
La tua funzione di ricerca potrebbe, perciò, essere scritta così:
Function CercaVertAndyCap(rngDove As Range, vbValore As Variant) As Variant
' ATTENZIONE:
' rngDove è un range composto da due colonne che contengono rispettivamente:
' la prima i valori sui quali effettuare la ricerca
' la seconda i valori da concatenare
' ho tralasciato il parametro colonna (in questo esempio, in quanto superfluo)
' la funzione va richiamata così: =CercaVertAndyCap(input!$A$2:$B$2504;output!A5)
'
Dim vbTabella As Variant
Dim sRisultato As String
Dim i As Long
vbTabella = rngDove.Value
For i = 1 To UBound(vbTabella)
If (vbValore = vbTabella(i, 1)) Then sRisultato = sRisultato & vbTabella(i, 2) & "; "
Next
If (Len(sRisultato) > 0) Then
CercaVertAndyCap = Mid(sRisultato, 1, Len(sRisultato) - 2)
Else
CercaVertAndyCap = CVErr(xlErrNA)
End If
End Function
Attenzione però:
- trattandosi di intervalli di dati abbastanza grandi, se la copi/incolli per 25.000 righe i tempi di calcolo si allungheranno proporzionalmente, anche se complessivamente saranno di molto inferiori alle tue due ore.
Sempre nell'ottica di ridurre ulteriormente i tempi di esecuzione, un approccio diverso, può essere quello di utilizzare una sub in luogo della function:
Sub ConcatenaStatico()
Dim avResult() As Variant
Dim vbTabella As Variant, vbValoriDaRicercare As Variant
Dim sRisultato As String
Dim lInd1 As Long, lInd2 As Long, lDim1 As Long, lDim2 As Long
'---------- carica in memoria le prime due colonne del foglio input (valori da cercare/concatenare)
With Sheets("input").UsedRange
vbTabella = .Resize(.Rows.Count, 2).Value
End With
lDim1 = UBound(vbTabella)
'---------- carica in memoria le prima colonna del foglio output (valori da ricercare)
With Sheets("output").UsedRange
vbValoriDaRicercare = .Resize(.Rows.Count, 1).Value
End With
'---------- dimensiona il risultato
lDim2 = UBound(vbValoriDaRicercare)
ReDim avResult(1 To lDim2)
'---------- la prima riga contiene l'intestazione, perciò la salto
For lInd1 = 2 To lDim2
sRisultato = vbNullString
For lInd2 = 2 To lDim1
If (vbValoriDaRicercare(lInd1, 1) = vbTabella(lInd2, 1)) Then
sRisultato = sRisultato & vbTabella(lInd2, 2) & "; "
End If
Next
If (Len(sRisultato) > 0) Then
avResult(lInd1) = Mid(sRisultato, 1, Len(sRisultato) - 2)
Else
avResult(lInd1) = CVErr(xlErrNA)
End If
Next
'---------- incolla il risultato nella colonna 5 del foglio 'output'
Sheets("output").Cells(1, 5).Resize(lDim2, 1).Value = WorksheetFunction.Transpose(avResult)
End Sub
Facendo così, il tempo si riduce drasticamente a meno di 1/2 minuto.
Un saluto,
Andrea.