Excel - gráfico (coluna) - Z-index da série de dados de acordo com o valor real

Uma maneira é criar uma tabela de processamento que trabalhe a ordem crescente da série.

As colunas E:G calculam o 1º menor, 2º menor e assim por diante usando a SMALL()fórmula, onde o primeiro parâmetro é sua linha de valores e o segundo a classificação - então a célula E3 é =SMALL($A3:$C3,1), F3 =SMALL($A3:$C3,2)e G3 =SMALL($A3:$C3,3). Copie quantas linhas você tiver e adicione quantas colunas precisar se forem mais de 3 séries.

Então precisamos de uma tabela de processamento, mostrada nas colunas J:R.

Uma coluna para cada série está presente, para cada posição possível em ordem crescente. No grupo de colunas "1ª", na coluna J podemos verificar se a série A é a 1ª menor série usando a fórmula

`=IF(E3=A3,A3,0)`

Se houver uma correspondência, o valor da série será mostrado. Se não, zero é mostrado.

Agora, se você criar seu gráfico de colunas clusterizadas usando o intervalo J2:R6 e aplicar 100% de sobreposição de série, verá que precisa reordenar as colunas. Usando a caixa de diálogo Selecionar dados , reordene as colunas para que 3C fique na parte superior e 1A na parte inferior.

Por fim, altere as cores de cada série. Todas as séries A devem ser azuis, todas as séries B devem ser laranja e C todas cinzas (ou quaisquer que sejam suas cores reais).

Criei macro para automação da solução da Andi Mohr . Talvez alguém ache útil.

Características/limitações:

• Funciona com gráficos de colunas verticais
• Cria uma tabela de "ajuda" com coluna para todas as séries parciais necessárias.
• Espera séries de dados em colunas
• A série de itens desabilitados (em "Selecionar fonte de dados") pode quebrar a macro!
• A mesa de "ajuda" pode ser movida para outra planilha
• A interatividade com a tabela original é mantida
• A cor da coluna (preenchimento) é copiada do gráfico de origem

Uso

1. Copie o código para o módulo VBA
2. Selecione a tabela de origem
3. Execute a macro

GIF

Código

Option Explicit

Public Sub Chart_ZIndexAdjusted()
    Dim SourceChart As Chart
    Set SourceChart = ActiveChart
    
    If SourceChart Is Nothing Then
        Call MsgBox("No chart selected." & vbNewLine & "(Do not select chart Axis!)", vbOKOnly + vbExclamation, "Error")
        Exit Sub
    End If
    
    'Check Chart type
    Select Case SourceChart.ChartType
    Case xlColumnClustered 'comma separated values
        Debug.Print "ChartType OK"
    Case Else
        Call MsgBox("ChartType: " & CStr(SourceChart.ChartType) & " is not supported." & vbNewLine & vbNewLine & "More about ChartTypes: https://docs.microsoft.com/en-us/office/vba/api/excel.xlcharttype", vbOKOnly + vbExclamation, "Error")
        Exit Sub
    End Select
    
    Dim SeriesCol As SeriesCollection
    Set SeriesCol = SourceChart.SeriesCollection 'All series from the chart
    
    Dim ValRng() As Range
    ReDim ValRng(1 To SeriesCol.Count) 'Range arrays for each series
    
    Dim NameRng() As Range
    ReDim NameRng(1 To SeriesCol.Count) 'Range with name for each series
    
    Dim CategoriesVal As String 'Value specifying categories
    
    Dim SeriesCount As Long
    SeriesCount = SeriesCol.Count
    
    'Ranges addresses could be retrieved for each series from its Formula property
    Dim i As Long
    For i = 1 To SeriesCount
        Dim FormulaParts() As String
        FormulaParts = Split(SeriesCol(i).Formula, ",")

        Set NameRng(i) = Range(Mid(FormulaParts(0), Len("=SERIES(") + 1, Len(FormulaParts(0)) - Len("=SERIES(")))
        Set ValRng(i) = Range(FormulaParts(2))
        If i = 1 Then
                CategoriesVal = FormulaParts(1)
        End If
    Next i
    
    'Check if all data are in one "table" and sheet
    Dim ValuesStartRow As Long
    Dim ValuesLength As Long
    Dim Sheet As Worksheet
    ValuesStartRow = ValRng(1).Cells.Item(1).Row
    ValuesLength = ValRng(1).Cells.Rows.Count
    Set Sheet = ValRng(1).Parent
    For i = 2 To SeriesCol.Count
        If Not ((ValuesStartRow = ValRng(i).Cells.Item(1).Row) _
                And (ValuesLength = ValRng(i).Cells.Rows.Count) _
                And (Sheet Is ValRng(i).Parent)) _
        Then
            Call MsgBox("Chart values are not on same sheet or lines or series does not have same length", vbOKOnly + vbExclamation, "Error")
            Exit Sub
        End If
    Next i
    
    Dim NTName As String 'Name for a new table for chart
    NTName = SourceChart.Name & "_InputData"
    
    'Look for old table and remove it
    With Sheet.ListObjects
        For i = 1 To .Count
            If .Item(i).Name = NTName Then
                .Item(i).Delete
            End If
        Next i
    End With
    
    'check if there is space for table headers
    If ValuesStartRow < 2 Then
        Call MsgBox("No space for a new table headers" & vbNewLine & "(Add a row on top of the sheet and try it again.)", vbOKOnly + vbExclamation, "Error")
    End If
    
    Dim NTRange As Range 'New Table Range
    Set NTRange = Sheet.Cells(ValuesStartRow - 1, Sheet.UsedRange.Columns.Count + 3) 'Placed two cells right from most right cell in the sheet
    
    Dim NTCols As Long
    NTCols = SeriesCount * SeriesCount 'Count of columns needed is series count ^2
    
    Set NTRange = NTRange.Resize(ValuesLength, NTCols)
    'NTRange.Select
 
    Dim NT As ListObject 'A new table for a new chart
    Set NT = Sheet.ListObjects.Add(xlSrcRange, NTRange)
    NT.Name = SourceChart.Name & "_InputData"
    NT.Range.Select 'Select a new table (it scrolls to its position)
    
    'Populate a new table headers
    Dim j As Long
    With NT.HeaderRowRange.Cells
        For i = 1 To SeriesCount
            For j = 1 To SeriesCount
                .Item((i - 1) * SeriesCount + j).Value2 = NameRng(j).Value2 & CStr(i)
            Next j
        Next i
    End With
    
    'Populate New Table with
    With NT.ListColumns
        For i = 1 To SeriesCount 'i is Z-index of column of the New Table
            Dim AllValsArray As String 'Array of addresses of all first series values
            AllValsArray = ValRng(1).Item(1).Address(False, False) 'The initial (1st) value (without delimiter)
            For j = 2 To SeriesCount
                AllValsArray = AllValsArray & "," & ValRng(j).Item(1).Address(False, False) 'delimiter + added value
            Next j
            
            Dim FormulaText As String
            For j = 1 To SeriesCount
                Dim ValueCellAddr As String 'Address of first cell with series values
                ValueCellAddr = ValRng(j).Item(1).Address(False, False)
                'Set text of formula
                FormulaText = "=IF(RANK.EQ(" & ValueCellAddr & ",(" & AllValsArray & "),0)=" & i & "," & ValueCellAddr & ",0)"
                'Insert formula to the first cell of the column
                .Item((i - 1) * SeriesCount + j).DataBodyRange.Formula = FormulaText
            Next j
        Next i
    End With
    
    Dim ChObj As ChartObject 'Chartobject for selected chart
    For Each ChObj In Sheet.ChartObjects
        If ChObj.Chart Is SourceChart Then
            Exit For
        End If
    Next ChObj
    
    Dim NTChName As String 'Name for a new chart
    NTChName = ChObj.Name & "_ZindexAdjusted"
    
    'Find and delete existing Z-index Adjusted chart
    With Sheet.ChartObjects
        For i = 1 To .Count
            If .Item(i).Name = NTChName Then
                Call .Item(i).Delete
            End If
        Next i
    End With

    Dim NTChObj As Object 'Must be Object Type! See: https://docs.microsoft.com/en-us/office/vba/api/excel.worksheet.chartobjects#return-value
    Set NTChObj = ChObj.Duplicate 'Create copy of the chart
    NTChObj.Name = NTChName 'Rename a new chart
    
    Dim FillColor() As Long
    ReDim FillColor(1 To SeriesCount)
    Dim LineColor() As Long
    ReDim LineColor(1 To SeriesCount)
    
    With SourceChart.SeriesCollection
        For i = 1 To SeriesCount
            'Saves color from the original chart
            FillColor(i) = SourceChart.SeriesCollection.Item(i).Format.Fill.ForeColor.RGB
            'LineColor(i) = SourceChart.SeriesCollection.Item(i).Format.Line.Forecolor.RGB
        Next i
    End With

    'Remove all series in copied chart
    With NTChObj.Chart.SeriesCollection
        For i = 1 To .Count
            .Item(1).Delete 'Item(1) because collection is re-numbered during loop
        Next i
        
        'Create a new series from the new table
        For i = 1 To NTCols
            Call .Add(NT.ListColumns.Item(i).Range, xlColumns, True, False) 'Add a new series
            With .Item(.Count).Format 'the last added series
                'Set series colors (only the fill acc. to orginal chart)
                .Fill.ForeColor.RGB = FillColor(i - (Fix((i - 1) / SeriesCount) * SeriesCount)) 'fix = trunc
                '.Line.Forecolor.RGB = FillColor(i - (Fix((i - 1) / SeriesCount) * SeriesCount))
            End With
        Next i
    End With
    
    'Set copy catergories labels
    If Len(CategoriesVal) > 0 Then
        NTChObj.Chart.FullSeriesCollection(1).XValues = "=" & CategoriesVal
    End If
    
'Lines bellow could be uncommented if you want features described in comments
'============================================================================

'    'Delete the original chart (not recommended)
'    Call ChObj.Delete

'    'Place the new chart over the original (original will be hidden under)
'    NTChObj.Left = ChObj.Left
'    NTChObj.Top = ChObj.Top

End Sub