Sostituisci anche la macro che elaborava la ricerca del numero spia e inserisci queste tre macro (la terza lunghissima è solo formattazione che purtroppo perde all'inizio del processo)
- Codice: Seleziona tutto
Sub TrovaSpia()
Set Ws1 = Worksheets("UK 49S IN ORDINE DI DATA")
Set Ws2 = Worksheets("spia.1mo")
Estr = Ws2.Range("G4").Value
Ws2.Range("I5:I53").ClearContents
Application.ScreenUpdating = False
Application.Calculation = xlManual
UR1 = Ws1.Range("A" & Rows.Count).End(xlUp).Row
For RR1 = 2 To UR1
Continua:
If Ws1.Cells(RR1, 3).Value = Estr Then
For NS = 1 To 49
If Ws1.Cells(RR1 + 1, 3).Value = NS Then
Ws2.Range("I" & NS + 4).Value = Ws2.Range("I" & NS + 4).Value + 1
RR1 = RR1 + 1
GoTo Continua
End If
Next NS
End If
Next RR1
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Call EvidenziaSpia
End Sub
Sub EvidenziaSpia()
Set Ws2 = Worksheets("spia.1mo")
Ws2.Range("I5:I53").ClearFormats
NumEv = Ws2.Range("A1").Value
NMax = Ws2.Cells(54, 9).Value
CNE = 0
M_Nm = 0
For NM = NMax To 1 Step -1
For RR2 = 5 To 53
If CNE >= NumEv Then GoTo SaltaC
If Ws2.Cells(RR2, 9).Value = NM Then
Ws2.Cells(RR2, 9).Interior.ColorIndex = 6
If M_Nm <> NM Then CNE = CNE + 1
M_Nm = NM
End If
Next RR2
Next NM
SaltaC:
Call FormattaCol
End Sub
Sub FormattaCol()
Range("I5:I53").Select
ActiveWindow.SmallScroll Down:=-30
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("I5:I53").Font.Bold = True
Range("A1").Select
End Sub
Poi nel VBA del foglio "spia.1mo"sostituisci con questo codice
- Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$G$4" Then GoTo SaltaR
Call TrovaSpia
SaltaR:
If Target.Address <> "$A$1" Then Exit Sub
Call EvidenziaSpia
End Sub
Per evidenziare i numeri ad ogni cambio valore in A1 (numeri da evidenziare)
Allego File
Ciao