salve
vedi qua:
Sub coloraselezione4up4dwn()
Dim rng As Range, rng1 As Range, rng2 As Range
Dim mysett As Variant, sett As Variant, Itx As Variant
Dim Mval As Variant, Mval2 As Variant, NextItx As Variant
Dim Area As Range, Ctrl As Boolean
Set rng = Range("B3", Range("B3").End(xlDown))
col = Selection.Column
counter = 0
'--------------------------------------
' Definisce l'area di selezione e conta le righe della selezione
miorange = Selection.Address
Set Area = Range(miorange).SpecialCells(xlCellTypeVisible)
For Each sel In Area
righe = righe + sel.Rows.Count
Next
'-------------------------------------------
For Each Itx In Area
counter = counter + 1
mysett = Cells(Itx.Row, 2).Value
i = Itx.Row
Do While Cells(i + 1, col).EntireRow.Hidden = True
i = i + 1
Loop
' il contatore serve per definire il limite di NextItx nel caso di selezioni parziali
'dei codici visibili-------------------------------------------------------
If counter < righe Then
NextItx = Cells(i + 1, col).Value
Else
NextItx = ""
End If
'-------------------------------------------------------------
For Each sett In rng
If sett = mysett Then
riga = sett.Row
'---------------------controllo Riga della selezione
blk1 = riga - 10
blk2 = riga - 14
blk3 = 4
If blk1 <= 3 Then blk1 = 3
If blk2 < 3 And blk1 > 3 Then
blk2 = 3
ElseIf blk1 <= 3 Then
Ctrl = True
End If
'-------------------------------------------------------------------------
If Not Ctrl Then
'zona -4
Set rng1 = Cells(blk2, 3).Resize(4, 5)
For Each Mval In rng1
If Mval.Value = Itx Then
Itx.Interior.ColorIndex = 6
End If
If Mval.Value = NextItx Then
Cells(i + 1, col).Interior.ColorIndex = 6
End If
Next Mval
End If
Set rng2 = Cells(riga, 3).Offset(1, 0).Resize(blk3, 5) 'zona +4
For Each Mval2 In rng2
If Mval2 = Itx And Itx.Interior.ColorIndex = xlNone Then
Itx.Interior.ColorIndex = 3
End If
If Mval2.Value = NextItx Then
Cells(i + 1, col).Interior.ColorIndex = 3
End If
Next Mval2
If NextItx = "" Then GoTo fine
Exit For
End If
Next sett
Ctrl = False
Next Itx
fine:
Set Area = Nothing
Set rng = Nothing
Set rng1 = Nothing
Set rng2 = Nothing
End Sub
NB:
nell'ipotesi che segue:
seleziono per il controllo i codici 18 e 19
controllo il codice 18 e lo trovo nella quartina inferiore (colore rosso)
controllo il suo successivo (19) e lo trovo nella quartina superiore del codice 18 (colore giallo
passo il controllo al codice 19
lo trovo nella quartina inferiore - qui nasce il problema- dovrebbe essere colorato di rosso ma ha già un colore
applicato precedentemente. Come si deve comportare??
saluti
Giap
