venerdì 25 marzo 2016

VBA EXCEL - Evidenzare Righe al variare del contenuto di una o + colonne

ITA: Evidenzia le righe di un range alternando due colori quando almeno uno dei valori delle colonne di rottura cambia ripetto alla riga precedente. ENG: Highlights the rows of a range by alternating two colors when at least one of the breakcolumn values is different than the previous line.
'
' Cambia il colore di sfondo quando una delle colonne di rottura cambia rispetto alla riga precedente
' Change the background color when one of the columnbreak is different from the previous line
'
Sub EnhanceRowBreaks(rng As Range, _
                     Optional BreakColumn As Integer = 1, _
                     Optional ColorIndex1 As Long = -4142, _
                     Optional ColorIndex2 As Long = 15, _
                     Optional ColorRGB2)
Dim c1 As Integer
Dim c2 As Integer
Dim cBreak As Integer
Dim c As Integer
Dim r As Long
Dim bColor As Boolean     ' Boolean Switch for enhaced color
Dim bUseColor As Boolean  ' True if use ColorRBG2 instead of ColorIndex2
Dim bkgColor(-1 To 0)
   
  c1 = rng.Column
  c2 = rng.Columns(rng.Columns.Count).Column
  cBreak = c1 + BreakColumn - 1
  bkgColor(0) = ColorIndex1
  bkgColor(-1) = ColorIndex2
  bUseColor = Not IsMissing(ColorRGB2)
  r = rng.Row
  Range(Cells(r, c1), Cells(r, c2)).Interior.ColorIndex = bkgColor(0)
  r = r + 1
 
  Do Until Cells(r, c1) = Empty
  ' Test if one of BreakColumns are changed
    For c = c1 To cBreak
      If (Cells(r, c) <> Cells(r - 1, c)) Then
      ' One of the test columns are not equal
        bColor = Not bColor
        Exit For
      End If
    Next
  ' Set background
    If bColor And bUseColor Then
    ' Use RGB color
      Range(Cells(r, c1), Cells(r, c2)).Interior.Color = ColorRGB2
    Else
    ' Use ColorIndex
      Range(Cells(r, c1), Cells(r, c2)).Interior.ColorIndex = bkgColor(bColor)
    End If
    r = r + 1
  Loop
End Sub

Nessun commento:

Posta un commento