Ciao Anthony, va alla grande :-) Grazie
Solo un'ultima richiesta:
Nelle colonne da confrontare ho dovuto aggiungere il campo "data" e il campo "cat" (in pratica si tratta di incontri di calcio).
Ho poi modificato la macro affinché mi evidenziasse in giallo tutta la riga (includendo quindi data, cat, squadra a e squadra b).
Il problema però è che se lancio la macro, nell'area di OUT, oltre ad avere riportate le partite comuni a tutte e tre le colonne analizzate, ho anche le partite che sono comuni solo in due delle tre colonne. (il mio scopo invece è di avere nell'out solo quelle partite che sono comuni in tutte e tre le colonne analizzate).
Dov'è che ho sbagliato?
Riporto la macro modificata (in pratica ho cambiato le lettere delle colonne da analizzare, la lettera della colonna dell'OUT e infine, nella sezione "colora e copia" la lunghezza da copiare).
Allego anche il file d'esempio.
Come vedi in colonna F:G mi trovo partite che non sono presenti in tutte e tre le colonne esaminate:
http://www.filedropper.com/esempio7Grazie in anticipo
- Codice: Seleziona tutto
Sub Strana()
Dim DI1 As String, DI2 As String, DI3 As String, DOut As String
Dim aAR(1 To 3), myP As Range, myDic As Object, myK As String, I As Long
'
DI1 = "A2" '<<< La prima area di partite
DI2 = "F2" '<<< La seconda
DI3 = "K2" '<<< La terza
DOut = "P2" '<<< L'area di Out
'
Set aAR(1) = Range(Range(DI1), Range(DI1).Offset(1000, 0).End(xlUp))
Set aAR(2) = Range(Range(DI2), Range(DI2).Offset(1000, 0).End(xlUp))
Set aAR(3) = Range(Range(DI3), Range(DI3).Offset(1000, 0).End(xlUp))
Set myDic = CreateObject("Scripting.Dictionary")
Range(Range(DOut), Range(DOut).Offset(0, 1).End(xlDown)).ClearContents
'Conta le occorrenze:
For I = 1 To 3
For Each myP In aAR(I)
myK = myP & myP.Offset(0, 1)
If myDic.exists(myK) Then
myDic.Item(myK) = myDic.Item(myK) + 1
Else
myDic.Add (myK), 1
End If
Next myP
Next I
'Colora o Copia:
For I = 1 To 3
For Each myP In aAR(I)
myK = myP & myP.Offset(0, 1)
If myDic.Item(myK) = 3 Then
myP.Resize(1, 4).Interior.Color = RGB(255, 255, 0) ' <<< qui ho messo un "4" perché l'area dati da analizzare è aumentata
myP.Resize(1, 4).Copy Range(DOut).Offset(1000, 0).End(xlUp).Offset(1, 0) ' <<< idem come sopra
Else
myP.Resize(1, 4).Interior.ColorIndex = xlNone ' <<< idem come sopra
' myP.Resize(1, 4).Copy Range(DOut).Offset(1000, 0).End(xlUp).Offset(1, 0) ' <<< qui ho disattivato perché non serve più
End If
Next myP
Next I
MsgBox ("Completato...")
End Sub