ciao CludiaBuonasera
Dov'è possibile trovare la macro di anthony di cui si parla nel video?
Grazie
Option Explicit
[COLOR=#008000]'Esempio di Collection[/COLOR]
[COLOR=#008000]'Le collection sono usate per contenere gruppi di variabili (di qualsiasi tipo anche[/COLOR]
[COLOR=#008000]'oggetti come Range, Worksheet, Array ecc.)[/COLOR]
[COLOR=#008000]'Le collection contengono keys e items[/COLOR]
[COLOR=#008000]'Le collection non possono contenere duplicati di key in quanto provocherebbe un errore[/COLOR]
[COLOR=#008000]'Per ovviare a questo si può usare la funzione "On Error Resume Next"[/COLOR]
[COLOR=#008000]'Hanno il difetto che una volta caricata una key, non si può leggere!!![/COLOR]
[COLOR=#008000]'Per ovviare a questo, creiamo nel Item un array a 2 Dim contenente Nome e Size[/COLOR]
Sub Duplicati_Collection_Array_2D()
Dim Coll As New Collection 'dichiarazione e creazione della collection
Dim uRiga As Integer, iRow As Integer, Risultato As Double
Dim Rng1 As Range, Rng2 As Range
Dim Matrix()
uRiga = Range("A" & Rows.Count).End(xlUp).Row [COLOR=#008000]'ultima riga piena[/COLOR]
Set Rng1 = Range("A1:A" & uRiga)[COLOR=#008000] 'attribuzione variabile oggetto[/COLOR]
Set Rng2 = Range("B1:B" & uRiga) [COLOR=#008000]'attribuzione variabile oggetto[/COLOR]
On Error Resume Next[COLOR=#008000] 'se c'è un errore, prosegui[/COLOR]
For iRow = 2 To uRiga [COLOR=#008000]'inizio ciclo[/COLOR]
Risultato = Application.WorksheetFunction.SumIf(Rng1, Cells(iRow, 1), Rng2)[COLOR=#008000] 'funzione somma se che determina la variabile "Risultato"[/COLOR]
Coll.Add Item:=Array(Cells(iRow, 1).Value, Risultato), key:=CStr(Cells(iRow, 1))[COLOR=#008000] 'caricamento in collection di Nome e Size in Item, con chiave univoca uguale al Nome[/COLOR]
Next
On Error GoTo 0
ReDim Matrix(1 To Coll.Count, 1 To 2)[COLOR=#008000] 'dimensioniamo la matrice[/COLOR]
For iRow = 1 To Coll.Count [COLOR=#008000]'inizio ciclo da 1 al numero dei valori contenuti in Collection[/COLOR]
Matrix(iRow, 1) = Coll(iRow)(0)[COLOR=#008000] 'scrive in matrice il Nome[/COLOR]
Matrix(iRow, 2) = Coll(iRow)(1)[COLOR=#008000] 'scrive in matrice il Valore[/COLOR]
Next
Range("D1").CurrentRegion.ClearContents[COLOR=#008000] 'svuota il range in D1 e relativa "regione corrente"[/COLOR]
Range("D1").Value = Range("A1").Value[COLOR=#008000] 'scrive le intestazioni[/COLOR]
Range("E1").Value = Range("B1").Value[COLOR=#008000] 'scrive le intestazioni[/COLOR]
Range("D2").Resize(UBound(Matrix, 1), UBound(Matrix, 2)) = Matrix[COLOR=#008000] 'scrive la matrice sul foglio[/COLOR]
[COLOR=#008000]'elimina le variabili[/COLOR]
Erase Matrix
Set Rng1 = Nothing
Set Rng2 = Nothing
Set Coll = Nothing
End Sub
[COLOR=#008000]'Esempio di Dictionary[/COLOR]
[COLOR=#008000]'Anche le Dictionary sono usate per contenere gruppi di variabili (di qualsiasi tipo anche[/COLOR]
[COLOR=#008000]'oggetti come Range, Worksheet, Array ecc.)[/COLOR]
[COLOR=#008000]'Anche le Dictionary contengono keys e items[/COLOR]
[COLOR=#008000]'Le Dictionary non possono contenere duplicati di key in quanto provocherebbe un errore[/COLOR]
[COLOR=#008000]'Per ovviare a questo si può usare il metodo .Exists[/COLOR]
[COLOR=#008000]'Le Dictionary possono leggere le key!!! al contrario delle Collection e possono essere scritte su Array[/COLOR]
[COLOR=#008000]'oppure direttamente su foglio.[/COLOR]
[COLOR=#008000]'Le Dictionary non essendo di MSExcel bisogna richiamare la libreria "Microsoft Scripting Runtime"[/COLOR]
[COLOR=#008000]'da Strumenti/Riferimenti (Early binding) oppure creare l'istanza nel modulo con CreateObject("Scripting.Dictionary")[/COLOR]
[COLOR=#008000]'(late binding)[/COLOR]
Sub Duplicati_Dictionary_Array_2D()
Dim Dict As Dictionary 'Object
Dim uRiga As Integer, iRow As Integer, Risultato As Double
Dim Rng1 As Range, Rng2 As Range
Dim Matrix()
Dim Nome As String
uRiga = Range("A" & Rows.Count).End(xlUp).Row [COLOR=#008000]'ultima riga piena[/COLOR]
Set Rng1 = Range("A1:A" & uRiga) [COLOR=#008000]'attribuzione variabile oggetto[/COLOR]
Set Rng2 = Range("B1:B" & uRiga) [COLOR=#008000]'attribuzione variabile oggetto[/COLOR]
Set Dict = New Dictionary 'Set Dict = CreateObject("Scripting.Dictionary")
For iRow = 2 To uRiga 'inizio ciclo
Risultato = Application.WorksheetFunction.SumIf(Rng1, Cells(iRow, 1), Rng2) [COLOR=#008000]'funzione somma se che determina la variabile "Risultato"[/COLOR]
Nome = Cells(iRow, 1)[COLOR=#008000] 'variabile nome[/COLOR]
If Not Dict.Exists(Nome) Then [COLOR=#008000]'se non esiste ...[/COLOR]
Dict.Add Item:=Array(Nome, Risultato), key:=Nome [COLOR=#008000]'caricamento in dictionary di Nome e Size in Item, con chiave univoca uguale al Nome[/COLOR]
End If
Next
ReDim Matrix(1 To Dict.Count, 1 To 2)[COLOR=#008000] 'dimensioniamo la matrice[/COLOR]
For iRow = 1 To Dict.Count [COLOR=#008000]'inizio ciclo[/COLOR]
Matrix(iRow, 1) = Dict.Items(iRow - 1)(0) [COLOR=#008000]'scrive in matrice il Nome[/COLOR]
Matrix(iRow, 2) = Dict.Items(iRow - 1)(1)[COLOR=#008000] 'scrive in matrice il Valore[/COLOR]
Next
Range("G1").CurrentRegion.ClearContents[COLOR=#008000] 'svuota il range in G1 e relativa "regione corrente"[/COLOR]
Range("G1").Value = Range("A1").Value [COLOR=#008000]'scrive le intestazioni[/COLOR]
Range("H1").Value = Range("B1").Value[COLOR=#008000] 'scrive le intestazioni[/COLOR]
Range("G2").Resize(UBound(Matrix, 1), UBound(Matrix, 2)) = Matrix[COLOR=#008000] 'scrive la matrice sul foglio[/COLOR]
[COLOR=#008000]'elimina le variabili[/COLOR]
Erase Matrix
Set Rng1 = Nothing
Set Rng2 = Nothing
Set Dict = Nothing
End Sub
[COLOR=#008000]'ancora piu' velocemente si puo' sfruttare un altra ... della collection[/COLOR]
Sub Duplicati_Dictionary_Array_1D_plus()
Dim Dict As Dictionary
Dim uRiga As Integer
Dim iRow As Integer
Dim Nome As String
Dim Size As Double
uRiga = Range("A" & Rows.Count).End(xlUp).Row
Set Dict = New Dictionary 'Set Dict = CreateObject("Scripting.Dictionary")
For iRow = 2 To uRiga [COLOR=#008000]'inizio ciclo[/COLOR]
Nome = Cells(iRow, 1)[COLOR=#008000] 'variabile Nome[/COLOR]
Size = Cells(iRow, 2)[COLOR=#008000] 'variabile Size[/COLOR]
Dict(Nome) = Size + Dict(Nome)[COLOR=#008000] 'nella Dictionary NOME assegna il valore esistente + il nuovo valore <<<= Rapidissimo[/COLOR]
Next
Range("D1").Value = Range("A1").Value [COLOR=#008000]'scrive le intestazioni[/COLOR]
Range("E1").Value = Range("B1").Value[COLOR=#008000] 'scrive le intestazioni[/COLOR]
[COLOR=#008000]'visto che le matrici Kesy e Items sono vettori bisogna trasportarli in "verticale" con la funzione .Transpose[/COLOR]
Range("d2").Resize(Dict.Count, 1) = Application.Transpose(Dict.Keys)[COLOR=#008000] 'scrive la matrice KEYS sul foglio!!![/COLOR]
Range("e2").Resize(Dict.Count, 1) = Application.Transpose(Dict.Items) [COLOR=#008000]'scrive la matrice ITEMS sul foglio!!![/COLOR]
[COLOR=#008000]'elimina Dictionary[/COLOR]
Set Dict = Nothing
End Sub
scusami Gerardo. ma credo che il tuo concetto di dialogo non coincida con il mio.... poi sempre per migliorare il nostro dialogo dobbiamo non interrompere le persone che spiegano anche se non si è d'accordo sul metodo (formula o codice) applicato, poi sarà l'utente a decidere se utile o meno...
se una persona dice una cosa che, a mio avviso, è scorretta e magari ho anche le risorse per poter giustificare il mio disappunto, non vedo perché non debba controbattere con le mie motivazioni.Dialogo (Treccani.it)
[FONT="]1.[/FONT][FONT="] [/FONT][FONT="]a.[/FONT][FONT="] Discorso, colloquio fra due o più persone: [/FONT][FONT="]prendere parte al d[/FONT][FONT="].; [/FONT][FONT="]ebbero un d[/FONT][FONT="]. [/FONT][FONT="]animato[/FONT][FONT="]; [/FONT][FONT="]ho udito alcune battute del d[/FONT][FONT="]. [/FONT][FONT="]fra i due[/FONT][FONT="]; fig., [/FONT][FONT="]fare un d[/FONT][FONT="]. [/FONT][FONT="]con sé stesso[/FONT][FONT="], [/FONT][FONT="]con i proprî pensieri[/FONT][FONT="]. Per estens., nel linguaggio polit. e giornalistico, incontro tra forze politiche diverse, discussione più o meno concorde o che miri a un’intesa: [/FONT][FONT="]il d[/FONT][FONT="]. [/FONT][FONT="]fra Oriente e Occidente[/FONT][FONT="]; [/FONT][FONT="]aprire un d[/FONT][FONT="]. [/FONT][FONT="]fra partiti contrapposti[/FONT][FONT="]; in senso più ampio, discussione aperta, di persone disposte a ragionare con spirito democratico: [/FONT][FONT="]mio padre non accetta il d[/FONT][FONT="].; [/FONT][FONT="]tra noi manca il d[/FONT][FONT="]., [/FONT][FONT="]ognuno resta della sua opinione[/FONT][FONT="].[/FONT].
Il messaggio completo e' nella Discussione che annunciava la live session, vedi http://www.forumexcel.it/forum/53-d...bre-ore-21-00?p=97131&viewfull=1#post97131Stimolato dagli irripetibili insulti di Draco durante la diretta dello scorso 10-ott-2017 ho sentito il bisogno di rivedere il file dimostrativo del listbox con filtro e ordinamento; il nuovo file, LBox_Demo_DA.xlsm (dove "DA" sta per Decent Architecture) e' scaricabile qui:
https://www.dropbox.com/s/dj9nskf6p4plbph/LBox_Demo_DA.xlsm?dl=0
Aiutaci a sostenere le spese e a mantenere online la community attraverso una libera donazione!