Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

confrontare banche dati

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

confrontare banche dati

Postdi wallace&gromit » 18/02/20 10:22

Ciao, vorrei imparare una volta per tutte (si spera) ad usare in modo ragionevole le banche dati con le macro.
Con le mie conoscenze base uso dei cicli for... next, per verificare se un dato di una lista è già presente nella banca dati.
Questo funziona per piccole serie, ma quando la lista si allunga il processo diventa molto lento.
So che si può lavorare con le matrici e ho già degli esempi funzionanti, ma vorrei imparare a costruirle.
Qui un esempio molto banale: in colonna A ho dei nomi, in B dei valori.
In G ho di nuovo i nomi della A (partiamo dall'ipotesi che non vi siano nomi nuovi che non figurano in A, semmai lo vediamo dopo).
In H devo aggiornare la lista dei valori corrispondenti della colonna B, la mia routine è questa:
Codice: Seleziona tutto
Sub confrontaBD()
URBD = Range("A" & Rows.Count).End(xlUp).Row
URVal = Range("G" & Rows.Count).End(xlUp).Row

For i = 2 To URVal
For j = 2 To URBD
If Cells(i, 7) = Cells(j, 1) Then
Cells(i, 8) = Cells(j, 2)
End If
Next j
Next i

End Sub


Un file di esempio è qui:
http://www.filedropper.com/macroconfrontabd
Office2016 su win7
Avatar utente
wallace&gromit
Utente Senior
 
Post: 1989
Iscritto il: 16/01/12 14:21

Sponsor
 

Re: confrontare banche dati

Postdi Anthony47 » 19/02/20 02:04

L'esempio che hai fatto non mi ispira, quindi vado con qualche considerazione generale...
Intanto, l'algoritmo che hai usato e' alquanto povero; perche' non c'e' bisogno di spazzolare tutta la tabella di origine per cercare la corrispondenza di un nome (almeno dovresti aggiungere un Exit For nel momento che la trovi), ma ci sono operazioni piu' dirette, ad esempio Confronta (Match) o Cerca.Vert (Vlookup) che puntano rapidamente alla riga.
Sempre nell'ottica della velocita' bisognerebbe puntare a evitare di ripetere piu' volte lo stesso loop, se i risultati possono essere "incasellati" nella posizione giusta in un unico loop.

Ad esempio, vedi file scaricabile qui: https://www.dropbox.com/s/87h3bc9j3zs6e ... .xlsm?dl=0

In Foglio2 ho modificato il contenuto della tua tabella in modo da avere circa 4000 righe con Nomi ripetuti; supponiamo ora di voler creare un riepilogo sullo stesso foglio con l'elenco unico dei Nomi e la somma delle rispettive quantita'.

Possiamo usare questa macro che usa un algoritmo con un solo ciclo sulla tabella di partenza:
Codice: Seleziona tutto
Sub Riepiloga()
Dim RPos As String, myMatch, I As Long
Dim BTab As String, J As Long, myTim As Single
'
RPos = "H1"         '<<< Destinazione
BTab = "A1"         '<<< Partenza
'
myTim = Timer
Range(RPos).CurrentRegion.ClearContents
Range(RPos).Resize(1, 2) = Array("Nome", "Somma Qt")
J = 2
Application.ScreenUpdating = False
For I = 2 To Range(BTab).Offset(Rows.Count - 10, 0).End(xlUp).Row
    myMatch = Application.Match(Cells(I, "A").Value, Range(RPos).Resize(J, 1), False)
    If IsError(myMatch) Then            'No match, valore non presente in tabella
        Range(RPos).Offset(J - 1, 0).Value = Cells(I, "A").Value
        Range(RPos).Offset(J - 1, 1).Value = Cells(I, "B").Value
        J = J + 1
    Else                                'Valore gia' presente in tabella
        Range(RPos).Offset(myMatch - 1, 1).Value = Range(RPos).Offset(myMatch - 1, 1).Value + Cells(I, "B").Value
    End If
Next I
Debug.Print Format(Timer - myTim, "0.00")   'Tempo necessario
Application.ScreenUpdating = True
Beep
End Sub

Qui usiamo Match (nella versione Application.Match, non Application.WorksheetFunction.Match) per controllare se un Nome e' gia' nel riepilogo; se c'e' aggiorniamo i valori, altrimenti si aggiunge e si mette il valore iniziale
Application.Match restituisce un risultato di errore se la voce cercata manca in elenco; la variante teoricamente piu' corretta WorksheetFunction.Match restituisce invece un run-time error, che e' piu' trigoso da gestire.

Se le righe sono tante ma tante, allora conviene creare in memoria una matrice copia dei dati di partenza e scorrere poi questa matrice invece che i dati di origine. Idem invece di scrivere volta per volta nella tabella dei risultati possiamo crearci una matrice in memoria e poi scrivere tutto insieme sul foglio

Ad esempio:
Codice: Seleziona tutto
Sub Riepiloga2()
Dim RPos As String, myMatch, I As Long
Dim BTab As String, J As Long, myTim As Single
Dim WorkArr, ONArr(), OVArr()
'
RPos = "H1"         '<<< Destinazione
BTab = "A1"         '<<< Partenza
'
myTim = Timer
Range(RPos).CurrentRegion.ClearContents
Range(RPos).Resize(1, 2) = Array("Nome", "Somma Qt")
J = 1
'Copia in WorkArr la tabella di partenza)
WorkArr = Range(Range(BTab).Offset(1, 0), Range(BTab).Offset(Rows.Count - 10, 1).End(xlUp)).Value
'Ridimensiono le matrici di Output
ReDim ONArr(LBound(WorkArr, 1) To J + 1)                    'Array dei Nomi, corta e poi ridimensionata
ReDim OVArr(LBound(WorkArr, 1) To UBound(WorkArr, 1))       'Array dei valori, lunga quanto i dati di partenza
'
'Spazzolo il contenuto di WorkArr:
For I = 1 To UBound(WorkArr)
    myMatch = Application.Match(WorkArr(I, 1), ONArr, False)            'Confronto con la matrice dei Nomi
    If IsError(myMatch) Then                                            'No match, valore non presente in matrice
        ONArr(J) = WorkArr(I, 1)                                        'Aggiungo in matrice Nomi e matrice Valori
        OVArr(J) = WorkArr(I, 2)
        J = J + 1
        ReDim Preserve ONArr(1 To J + 1)
    Else                                                                'Valore gia' presente in matrice, incrementa il valore
        OVArr(myMatch) = OVArr(myMatch) + WorkArr(I, 2)
    End If
Next I
Range(RPos).Offset(1, 0).Resize(J, 1) = Application.WorksheetFunction.Transpose(ONArr)  'Scrive in blocco i Nomi
Range(RPos).Offset(1, 1).Resize(J, 1) = Application.WorksheetFunction.Transpose(OVArr)  'Scrive in blocco i valori
'
Debug.Print Format(Timer - myTim, "0.00")   'Tempo necessario
Beep
End Sub


Qui vediamo che inizialmente popoliamo la variante WorkArr con la matrice dei valori di tabella (WorkArr = Range etc etc)
Vediamo anche che Match puo' avere come target una matrice, non necessariamente un Range; pero' solo una matrice monodimensionale. Quindi per i nomi da creare mi appoggio sulla matrice ONArr e per i valori a una OVArr "parallela"
Una curiosita': la ONArr la dimensiono corta e poi la ridimensiono man mano che aggiungo i nomi, mentre la OVArr la dimensiono sulla lunghezza massima teorica. Questo perche' la ONArr viene usata come intervallo dalla funzione Match, che (nella variante con parametro False) lavora sequenzialmente, quindi una matrice corta accorcia i tempi di esecuzione.

Alla fine, ONArr e OVArr devono essere trasformati da matrice orizzontale in matrice verticale e possono essere "pompati" nell'intervallo di destinazione (l'area del risultato)

Tieni presente che in questo esempio ho potuto usare Match per testare se un Nome e' gia' in elenco; ma se gia' dovessi testare strutture piu' complesse potrebbe essere utile ricorrere a un "dictionary"; per una infarinatura: viewtopic.php?t=96606 (contiene anche un link a una discussione in cui il Dictionary serve a velocizzare una ricerca, e dove viene anche richiamata un'altra struttura dati, la Collection)

In ambedue i casi, la Debug.Print a fine macro scrive nella "Finestra Immediata" del vba il tempo impiegato; per accedere alla finestra Immediata basta la combinazione Contr-g, oppure Menu /Visualizza /Finestra Immediata

Spero che trovi qualche spunto per partire con i tuoi esperimenti.

Ciao

PS: per chi ha Excel 365 con la nuova funzione UNICI, lo stesso risultato ottenuto qui con le macro dimostrative e' ottenibile con semplici formula, come mostrato sempre su Foglio2 del file dimostrativo linkato prima
Avatar utente
Anthony47
Moderatore
 
Post: 16793
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: confrontare banche dati

Postdi wallace&gromit » 19/02/20 14:40

Grazie, ero ovviamente conscio del fatto che la mia procedura fosse particolarmente "pesante", ma era l'unica che riuscivo a fare funzionare, ora ho un po' di spunti su cui lavorare.
Office2016 su win7
Avatar utente
wallace&gromit
Utente Senior
 
Post: 1989
Iscritto il: 16/01/12 14:21

Re: confrontare banche dati

Postdi marcus69 » 22/02/20 21:40

Anthony47 Numero1!!!
marcus69
Utente Junior
 
Post: 65
Iscritto il: 19/10/17 14:39


Torna a Applicazioni Office Windows


Topic correlati a "confrontare banche dati":


Chi c’è in linea

Visitano il forum: Nessuno e 23 ospiti