mega.nz
Lotto versione 53
Aggiunta l'evidenziazione al foglio TabFigure. Si possono evidenziare una o più Figure. Un pulsante consente di eliminare le evidenziazioni:
Per evidenziare ho utilizzato questa macro (che sfrutta la formattazione condizionale):
-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub EvidenziaFigureColoriDiversi()
Dim wsFigure As Worksheet
Dim figuraRicerca As Variant
Dim rngB1 As Range, rngB2 As Range
Dim offsetB1 As Long, offsetB2 As Long
Dim startRow As Long, endRow As Long
Dim colori() As Long
' Verifica che il foglio TabFigure esista
On Error Resume Next
Set wsFigure = ThisWorkbook.Sheets("TabFigure")
On Error GoTo 0
If wsFigure Is Nothing Then
MsgBox "Il foglio 'TabFigure' non esiste. Eseguire prima CreaFoglioFigureTabellone.", vbCritical
Exit Sub
End If
' Definisci i range da controllare
startRow = 3
endRow = 303 ' Equivalente a 313-13+3
offsetB1 = 2 ' Colonna B
offsetB2 = 52 ' Colonna BD
Set rngB1 = wsFigure.Range(wsFigure.Cells(startRow, offsetB1), wsFigure.Cells(endRow, offsetB1 + 49))
Set rngB2 = wsFigure.Range(wsFigure.Cells(startRow, offsetB2), wsFigure.Cells(endRow, offsetB2 + 4))
' Richiedi all'utente la figura da evidenziare
figuraRicerca = InputBox("Inserisci il numero delle figure da evidenziare (separate da virgola):", "Evidenzia Figure")
If figuraRicerca = "" Then Exit Sub ' L'utente ha annullato
' Rimuove tutte le formattazioni condizionali esistenti per le figure
rngB1.FormatConditions.Delete
rngB2.FormatConditions.Delete
' Definisci un array di colori diversi
ReDim colori(0 To 9)
colori(0) = RGB(255, 255, 0) ' Giallo
colori(1) = RGB(0, 255, 0) ' Verde
colori(2) = RGB(0, 255, 255) ' Ciano
colori(3) = RGB(255, 0, 255) ' Magenta
colori(4) = RGB(255, 128, 0) ' Arancione
colori(5) = RGB(128, 0, 255) ' Viola
colori(6) = RGB(255, 0, 128) ' Rosa
colori(7) = RGB(128, 255, 0) ' Lime
colori(8) = RGB(0, 128, 255) ' Azzurro
colori(9) = RGB(192, 192, 192) ' Grigio chiaro
' Crea un array di figure da evidenziare
Dim figureDaEvidenziare() As String
figureDaEvidenziare = Split(figuraRicerca, ",")
' Applica una formattazione condizionale per ogni figura da evidenziare
Dim i As Integer
For i = 0 To UBound(figureDaEvidenziare)
Dim figura As String
figura = Trim(figureDaEvidenziare(i))
If IsNumeric(figura) Then
Dim colorIndex As Integer
colorIndex = i Mod UBound(colori) + 1
' Aggiungi formattazione condizionale al primo range
With rngB1.FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:=figura)
.Interior.color = colori(colorIndex - 1)
.Font.Bold = True
.StopIfTrue = False
End With
' Aggiungi formattazione condizionale al secondo range
With rngB2.FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:=figura)
.Interior.color = colori(colorIndex - 1)
.Font.Bold = True
.StopIfTrue = False
End With
End If
Next i
MsgBox "Formattazione condizionale applicata per evidenziare le figure richieste con colori diversi.", vbInformation
End Sub
-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Per cancellare l'evidenziazione ho usato questa macro:
Sub RimuoviEvidenziazioneFigure()
Dim wsFigure As Worksheet
Dim rngB1 As Range, rngB2 As Range
Dim offsetB1 As Long, offsetB2 As Long
Dim startRow As Long, endRow As Long
' Verifica che il foglio TabFigure esista
On Error Resume Next
Set wsFigure = ThisWorkbook.Sheets("TabFigure")
On Error GoTo 0
If wsFigure Is Nothing Then
MsgBox "Il foglio 'TabFigure' non esiste.", vbCritical
Exit Sub
End If
' Definisci i range
startRow = 3
endRow = 303
offsetB1 = 2 ' Colonna B
offsetB2 = 52 ' Colonna BD
Set rngB1 = wsFigure.Range(wsFigure.Cells(startRow, offsetB1), wsFigure.Cells(endRow, offsetB1 + 49))
Set rngB2 = wsFigure.Range(wsFigure.Cells(startRow, offsetB2), wsFigure.Cells(endRow, offsetB2 + 4))
' Rimuove tutte le formattazioni condizionali
rngB1.FormatConditions.Delete
rngB2.FormatConditions.Delete
MsgBox "Tutte le evidenziazioni sono state rimosse.", vbInformation
End Sub
-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Inutile dire che le macro non le ho create io ma la AI. Diamo a Cesare quello che è di Alberto!
Bacicciuk