Formattazione condizionale

[joe]

Ciao Joe, Per Me va Bene, che strano nessuno che lo chiede, se non è un problema.

Si ma è nulla più che un esercizio, al quale ho voluto sottopormi.

In pratica fornisce la prova di quanto sia difficile poter avere un risultato utile.

Dunque è abbastanza, nelle cose, che non interessi.

 

[Baciccia4251]

Non ci stanno tutte le immagine, e ce ne sono ancora molte. Ma alla fine, quando ormai disperavo, ha usato un mio suggerimento e, apparentemente, ora funziona


è quello che volevo
Sub VerificaNumeriUguali()
Dim ws As Worksheet
Dim ultimaEstrazione As Range
Dim estrazioni As Range
Dim numeriUguali As Collection
Dim numero As Variant
Dim i As Integer, j As Integer, k As Integer
Dim ruote() As String
Dim colonneRuote As Variant
Dim ultimaRiga As Long
Dim cella As Range
Dim trovato As Boolean

Set ws = ThisWorkbook.Sheets("Archivio")

' Definisci le ruote e le loro colonne
ruote = Split("Bari,Cagliari,Firenze,Genova,Milano,Napoli,Palermo,Roma,Torino,Venezia,Nazionale", ",")
colonneRuote = Array("D:H", "I:M", "N:R", "S:W", "X:AB", "AC:AG", "AH:AL", "AM:AQ", "AR:AV", "AW:BA", "BB:BF")

' Trova l'ultima riga con dati
ultimaRiga = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' Rimuovi l'evidenziazione precedente
For k = LBound(ruote) To UBound(ruote)
Set estrazioni = ws.Range(ws.Cells(9, ws.Range(colonneRuote(k)).Columns(1).Column), ws.Cells(ultimaRiga, ws.Range(colonneRuote(k)).Columns(ws.Range(colonneRuote(k)).Columns.Count).Column))
estrazioni.FormatConditions.Delete ' Rimuovi tutte le regole di formattazione condizionale esistenti
Next k

' Analizza ogni ruota
For k = LBound(ruote) To UBound(ruote)
Set numeriUguali = New Collection
Set ultimaEstrazione = ws.Range(ws.Cells(ultimaRiga, ws.Range(colonneRuote(k)).Columns(1).Column), ws.Cells(ultimaRiga, ws.Range(colonneRuote(k)).Columns(ws.Range(colonneRuote(k)).Columns.Count).Column))
Set estrazioni = ws.Range(ws.Cells(ultimaRiga - 18, ws.Range(colonneRuote(k)).Columns(1).Column), ws.Cells(ultimaRiga - 1, ws.Range(colonneRuote(k)).Columns(ws.Range(colonneRuote(k)).Columns.Count).Column))

' Trova i numeri uguali nelle estrazioni precedenti
For Each cella In ultimaEstrazione
numero = cella.Value
If IsNumeric(numero) And Val(numero) <> 0 Then
For i = 1 To estrazioni.Rows.Count
For j = 1 To estrazioni.Columns.Count
If estrazioni.Cells(i, j).Value = numero Then
On Error Resume Next
numeriUguali.Add numero, CStr(numero) ' Aggiungi numero alla collezione
' Aggiungi una regola di formattazione condizionale
With estrazioni.Cells(i, j).FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=" & numero)
.Interior.Color = RGB(255, 255, 0) ' Imposta colore giallo
End With
On Error GoTo 0
End If
Next j
Next i
End If
Next cella

' Evidenzia anche l'ultima estrazione se ci sono numeri uguali
If numeriUguali.Count > 0 Then
For Each cella In ultimaEstrazione
trovato = False
For Each numero In numeriUguali
If cella.Value = numero Then
trovato = True
Exit For
End If
Next numero
If trovato Then
' Aggiungi una regola di formattazione condizionale
With cella.FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=" & numero)
.Interior.Color = RGB(255, 255, 0) ' Imposta colore giallo
End With
End If
Next cella
End If
Next k
End Sub



A cosa possa servire sfugge dalla mia comprensione. Ha funzionato aggiungendo una estrazione ora provo con più estrazioni, funzionerà?
Lo saprete solo inviandomi 23456 euro
Bacicciuk