Scorrere elenchi cercando dati uguali e riunire i dati correlati al valore trovato.

Utilizzo di ciclo For Each Next interno a ciclo Do  While Loop: ovvero: l'unione fa la forza.

 

Un amico, lettore del sito, ha ricevuto una richiesta di aiuto per elaborare un file che deve servire come base per altre applicazioni: in una colonna di un foglio esistono dei valori che appaiono uguali e in intervalli diversi (Colonna C); si vuole riunire nella colonna a destra, la Colonna D,  tutte le occorrenze che si trovano nella Colonna B; vediamo l'esempio:

si vuole cioè ottenere in ogni riga della colonna D, per ogni codice uguale letto, una matrice di valori correlati al codice uguale, valori reperiti nella colonna B. come la sequenza di 15 "scolli" legati al codice 00104089, quindi 00017560,00017561,00017562,00017563,00017564,00017565,00017566,00018270,00018271,00018598,00018599,00019585,00019586,00019587,00104089, riportati per ogni riga della colonna D interessate al codice uguale, come nell'esempio sotto:

Ovviamente non ci interessa capire il perchè sia richiesto questo esercizio, ma può essere interessante esaminare le soluzioni trovate per ottenere il risultato che vediamo sopra.

Normalmente per fare una comparazione (in vba) si scorrono due o più colonne contenenti i dati da comparare utilizzando un qualsiasi ciclo For Next, ma qui ci troviamo a dover comparare dati di una stessa colonna e che siano uguali, quindi si deve trovare un modo di interrompere la comparazione quando si trovano dati diseguali; dobbiamo memorizzare i dati correlati (quelli nella colonna a sinistra, la B) al valore trovato uguale per poi scriverli tutti legati da una virgola al termine dei valori uguali : possiamo usare una matrice dove memorizzare detti dati per scaricarli poi tutti insieme nelle righe della colonna D, per ogni riga di tutto l'intervallo dei dati uguali.

Creare un matrice di valori non è poi tanto difficile da realizzare, il problema nasce quando dobbiamo individuare da quale riga e fino a quale riga prendere in considerazione per riempire la nostra matrice, considerando che nello scorrere la colonna C alla ricerca di dati uguali, se scorriamo la colonna C con istruzioni simili a " if ActiveCell = ActiveCell.Offset(1, 0) Then ecc. ecc " , cioè controllare se la cella sottostante a quella letta in quel momento ha il valore uguale, resteremo sempre con 2 valori da reperire alato nella colonna B non letti, non considerati.

La pensata quindi è stata: scorriamo la colonna D che inizialmente sarà vuota, con un ciclo While Wend, e se la cella letta nel ciclo sarà diversa da vuota, cioè occupata, incrementiamo di 1 il valore della variabile riga (che all'inizio impostamo a 1) altrimenti se la cella colonna D sarà vuota, iniziamo un ciclo For Each Next che esegua la comparazione tra le celle della colonna C e carichi la matrice con i dati correlati della colonna B;

non scordiamo che siamo alla riga 1 della colonna C mentre in ciclo interno For Each Next si compie, e quando sarà finito, disponendo della riga iniziale e della riga finale lette, iniziamo un ulteriore ciclo For Next che scarichi la matrice nelle righe della colonna D.

A questo punto con un GoTo rinviamo le istruzioni all'inizio del ciclo While Wende che ora inizierà a comparare le righe a partire dall'ultima occupata dal ciclo appena completato.

A me le istruzioni funzionano alla grande e le comunico all'amico Roberto, il quale mi dice che a lui si bloccano e non funzionano (misteri impenetrabili dei PC: forse scarsa potenza di calcolo ?? chissà ??) forse la routine entra in un Loop ??? non mi pare anche perchè ho inserito l'istruzione che se si supera la riga occupata si esce dalla routine stessa ( If riga = UR + 1 Then Exit Sub ) dove con UR si è letta l'ultima riga occupata nella colomma C, quella da comparare (UR = Sheets(1).Range("C65536").End(xlUp).Row).

Se qualche lettore mi saprà fornire una plausibile motivazione gli sarò molto grato. (allego il file per provare sui vostri PC, routine Ennius).

Comunque l'amico Roberto non si perde d'animo e corregge le mie istruzioni inserendo un For Next esterno che scorrerà tante volte quanto è la differenza tra 1 e UR  e un ciclo Do While Loop che interrompe le istruzioni ed esce dal ciclo con Exit Do senza usare il GoTo, togliendo inoltre l'ultima virgola inserita in matrice; ovviamente anche le sue istruzioni funzionano, e visto che funzionano sul PC che rifiutava le mie, direi che le sue sono senza dubbio migliori.

Allego comunque le due routine:

routine di ennius
Sub Ennius()
Dim CL As Object
UR = Sheets(1).Range("C65536").End(xlUp).Row
riga = 1
10:

While Sheets(1).Cells(riga, 4) <> ""
riga = riga + 1
If riga = UR + 1 Then Exit Sub
Wend

Set zona = Sheets(1).Range(Cells(riga, 3), Cells(UR, 3))
zac = ""    
 'zac è la matrice che conterrà i valori correlati + una virgola per ogni valore

For Each CL In zona
If CL = CL.Offset(1, 0) Then
zac = zac & CL.Offset(0, -1) & ","
Lastr = CL.Row 
 'Lastr è il contatore che riporterà il punultimo numero di riga letta nel ciclo For
Else
Exit For

End If
Next

For M = riga To Lastr + 1 
'questo è il ciclo che scorrerà la colonna D per scaricarci la matrice zac
Sheets(1).Cells(M, 4) = zac & Cells(Lastr + 1, 2) & ","
Next

GoTo 10
End Sub
routine di Roberto
Dim CL As Object
UR = Sheets(1).Range("C65536").End(xlUp).Row
riga = 1
Cells(1, 4) = "simple_skus"
For X = 1 To UR
Do
Do While Sheets(1).Cells(riga, 4) <> ""
riga = riga + 1
If riga = UR + 1 Then
Exit Do
End If
Loop
Loop Until Check = False
Set zona = Sheets(1).Range(Cells(riga, 3), Cells(UR, 3))
zac = ""
For Each CL In zona
If CL = CL.Offset(1, 0) Then
zac = zac & CL.Offset(0, -1) & ","
Lastr = CL.Row
Else
Exit For
End If
Next
For M = riga To Lastr + 1
Sheets(1).Cells(M, 4) = Left(Cells(Lastr + 1, 2) & "," & zac, Len(Cells(Lastr + 1, 2) & "," & zac) - 1)
Next

Next

 

 

file da consultare e scaricare:  Articoli.rar  35 kb


 

 

 

buon lavoro.

prelevato sul sito www.ennius.altervista.org