Gostaria de destacar automaticamente várias linhas com base no grupo de números em uma coluna. Então, eu teria uma cor de linha diferente para cada ID de família exclusiva. Existe uma maneira de fazer isso sem ter que selecionar manualmente uma cor na formatação condicional? Eu tenho 400 famílias e mais de 1000 linhas. Obrigado pela ajuda pessoal.
Exemplo de dados:
FamilyID Stock Number Class
1922 1361427 Box
1922 5859184 Box
1922 1422784 Box
1922 1422694 Box
2196 1336358 Circle
2196 1336244 Circle
2196 675239 Circle
2205 57813 Square
2205 863453 Square
2220 30664 Square
2220 1336732 Square
2220 22874 Square
Supondo que FamilyID esteja em ColumnA , use uma série de regras de formatação condicional em Use uma fórmula para determinar quais células serão formatadas (do tipo = $ a2 = 1922 (amarelo), = $ a2 = 2196 (verde) etc.) em A2 e cada um se aplica à linha inteira.
As seguintes funções de suporte e rotina VBA do Excel fornecem a funcionalidade para destacar várias linhas com base em grupos de números na primeira coluna de um intervalo de dados, uma facilidade que, de outra forma, só pode ser obtida com a formatação condicional. Qualquer número de colunas e linhas pode ser selecionado, embora eu não tenha testado o desempenho em tabelas grandes.
O código é direto, percorrendo as células no intervalo selecionado e aplicando uma nova cor quando o valor na primeira coluna muda conforme o programa prossegue no intervalo.
O esquema de seleção de cores é muito básico. As cores equidistantes no espectro suportado pelo Excel (2007+) são selecionadas com base no número de cores distintas definidas no programa (atualmente 16) e, em seguida, atribuídas aleatoriamente aos agrupamentos de linhas na tabela de dados.
Para cores escuras, os números ou texto nas células são definidos em branco para contraste.
As duas funções de suporte fornecem os códigos da cor de preenchimento e da cor da fonte à rotina principal.
Sub ColorSortedRange()
' Set the fill color of rows in a selected range based on the values
' in the first column of the range.
Dim Rng As Range, Rng2 As Range
Dim Cell_ As Range
Dim PriorCellValue As Variant
Dim CellColor As Long, FontColorIdx As Long
Dim NumberOfColors As Long
With Application
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
End With
Set Rng = Selection
NumberOfColors = 16 '####### SET NUMBER OF COLORS HERE #######
For Each Cell_ In Rng.columns(1).Cells
If Cell_.Value <> PriorCellValue Then
CellColor = GetColorNumber(NumberOfColors)
FontColorIdx = GetFontColorIndex(CellColor) '
End If
Set Rng2 = Range(Cell_, Cell_.Offset(0, Rng.columns.Count - 1))
With Rng2
With .Interior
.Color = CellColor
.TintAndShade = 0.5 '####### SET TINTING AND SHADING HERE #######
End With
.Font.ColorIndex = FontColorIdx
End With
PriorCellValue = Cell_.Value
Next
With Application
.EnableEvents = True
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
Function GetColorNumber(NumberOfColors As Long) As Long
' Returns a color number randomly chosen from the number of
' colors specified. This function will not work in Excel versions
' prior to 2007, because of limits on the number of available
' colors.
Dim Step As Long
Dim NumberOfExcelColors As Long
NumberOfExcelColors = 16276000 'approximately
Step = Fix(NumberOfExcelColors / NumberOfColors)
GetColorNumber = WorksheetFunction.RandBetween(1, NumberOfColors) * Step
' The Randbetween function is from the Excel Analysis ToolPak. If it is
' unavailable the following formula can be substituted:
' =INT((upperbound - lowerbound + 1) * RAND() + lowerbound)
End Function
Function GetFontColorIndex(BackgroundColor As Long) As Integer
' Returns color index for dark grey or white, which the function selects
' to contrast with the cell fill color.
Dim R As Long, G As Long, B As Long
Dim FontThreshold As Double
Dim Brightness As Double
R = BackgroundColor Mod 256
G = (BackgroundColor \ 256) Mod 256
B = (BackgroundColor \ 256 \ 256) Mod 256
FontThreshold = 130
Brightness = Sqr(R * R * 0.241 + G * G * 0.691 + B * B * 0.068)
If Brightness < FontThreshold Then
GetFontColorIndex = 2 'white
Else
GetFontColorIndex = 49 'dark (1 is black)
End If
' Long decimal to RGB color conversion algorithm published by Siddharth Rout
' at http://social.msdn.microsoft.com/Forums/en/exceldev/thread/df8a1e1e-e974
' -4a9c-938a-da18ae9f5252. The formula for perceived brightness of RGB colors
' is available in various forms on the Internet, perhaps earliest at
' http://alienryderflex.com/hsp.html.
End Function
Eu peguei o código acima e o aprimorei para que não haja chance de você ter uma célula com a mesma cor ... enjoy:)
Dim LastColor As Long
Sub ColorSortedRange()
LastColor = GetColorNumber(5)
' Set the fill color of rows in a selected range based on the values
' in the first column of the range.
Dim Rng As Range, Rng2 As Range
Dim Cell_ As Range
Dim PriorCellValue As Variant
Dim CellColor As Long, FontColorIdx As Long
Dim NumberOfColors As Long
With Application
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
End With
Set Rng = Selection
NumberOfColors = 50 '####### SET NUMBER OF COLORS HERE #######
For Each Cell_ In Rng.Columns(1).Cells
If Cell_.Value <> PriorCellValue Then
CellColor = GetColorNumber(NumberOfColors, LastColor)
LastColor = CellColor
FontColorIdx = GetFontColorIndex(CellColor) '
End If
Set Rng2 = Range(Cell_, Cell_.Offset(0, Rng.Columns.Count - 1))
With Rng2
With .Interior
.Color = CellColor
.TintAndShade = 0.5 '####### SET TINTING AND SHADING HERE #######
End With
.Font.ColorIndex = FontColorIdx
End With
PriorCellValue = Cell_.Value
Next
With Application
.EnableEvents = True
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
Function GetColorNumber(NumberOfColors As Long, Optional OldColor As Long = 0) As Long
' Returns a color number randomly chosen from the number of
' colors specified. This function will not work in Excel versions
' prior to 2007, because of limits on the number of available
' colors.
Dim Step As Long
Dim NumberOfExcelColors As Long
NumberOfExcelColors = 16276000 'approximately
Step = Fix(NumberOfExcelColors / NumberOfColors)
GetColorNumber = WorksheetFunction.RandBetween(1, NumberOfColors) * Step
If GetColorNumber = OldColor Then
GetColorNumber = GetColorNumber(NumberOfColors, OldColor)
End If
' The Randbetween function is from the Excel Analysis ToolPak. If it is
' unavailable the following formula can be substituted:
' =INT((upperbound - lowerbound + 1) * RAND() + lowerbound)
End Function
Function GetFontColorIndex(BackgroundColor As Long) As Integer
' Returns color index for dark grey or white, which the function selects
' to contrast with the cell fill color.
Dim R As Long, G As Long, B As Long
Dim FontThreshold As Double
Dim Brightness As Double
R = BackgroundColor Mod 256
G = (BackgroundColor \ 256) Mod 256
B = (BackgroundColor \ 256 \ 256) Mod 256
FontThreshold = 130
Brightness = Sqr(R * R * 0.241 + G * G * 0.691 + B * B * 0.068)
If Brightness < FontThreshold Then
GetFontColorIndex = 2 'white
Else
GetFontColorIndex = 49 'dark (1 is black)
End If
' Long decimal to RGB color conversion algorithm published by Siddharth Rout
' at http://social.msdn.microsoft.com/Forums/en/exceldev/thread/df8a1e1e-e974
' -4a9c-938a-da18ae9f5252. The formula for perceived brightness of RGB colors
' is available in various forms on the Internet, perhaps earliest at
' http://alienryderflex.com/hsp.html.
End Function