Excel VBA: создать кластеризованную столбчатую диаграмму, которая сортирует по значению, а не по серии?

Вот моя проблема: у меня есть указанное пользователем количество наборов данных, которые я хочу нанести на столбчатый столбчатый график. Я создаю диаграмму в Visual Basic и добавляю наборы данных в виде отдельных рядов, чтобы они различались по цвету и имели разные названия в легенде:

ActiveWorkbook.Charts.Add 'all of this just adds a new chart
ActiveChart.ChartArea.Select
With ActiveChart
    .ChartType = xlColumnClustered
    .HasTitle = True
    .ChartTitle.Text = "Ordered Distribution Graph"
    .Axes(xlCategory, xlPrimary).HasTitle = True
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Item"
    .Axes(xlCategory, xlPrimary).CategoryType = xlCategoryScale
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Total"
    .Legend.Position = xlLegendPositionBottom
End With

ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.count)
ActiveSheet.Name = "Distribution Chart"

For j = 0 To UBound(chartLabels) 'here is where I handle the data based on global variables
    If IsEmpty(chartLabels(j)) Then Exit For
    Erase xval
    Erase yval
    ReDim Preserve xval(0 To 0)
    ReDim Preserve yval(0 To 0)
    xval(0) = chartData(0, j, 0)
    yval(0) = chartData(2, j, 0)

    For i = 0 To UBound(chartData, 3) - 1
        If Not IsEmpty(chartData(2, j, i + 1)) Then
            ReDim Preserve xval(0 To i + 1)
            ReDim Preserve yval(0 To i + 1)
            xval(i + 1) = chartData(0, j, i + 1)
            yval(i + 1) = chartData(2, j, i + 1)
        End If
    Next

    Call bubblesortData(j, UBound(xval)) 'separate sort function

    ActiveChart.SeriesCollection.NewSeries 'plots each series
    ActiveChart.SeriesCollection(j + 1).XValues = xval
    ActiveChart.SeriesCollection(j + 1).Values = yval
    ActiveChart.SeriesCollection(j + 1).Name = main.chartLabels(j)
    ActiveChart.ChartGroups(1).GapWidth = 10
    ActiveChart.ChartGroups(1).Overlap = -10
Next

Sheets(ActiveWorkbook.Sheets.count).Activate

В настоящее время каждый набор данных сортируется с помощью функции bubblesortData(setNumber, numberOfDataPoints) (xval и yval являются глобальными массивами):

Sub bubblesortLosses(b As Variant, tot As Variant)
Dim changed As Integer, temp As Variant

Do
changed = 0
    For i = 0 To tot - 1
    If Not IsEmpty(xval(i)) Then
        If yval(i) > yval(i + 1) Then
            temp = xval(i)
            xval(i) = xval(i + 1)
            xval(i + 1) = temp
            temp = yval(i)
            yval(i) = yval(i + 1)
            yval(i + 1) = temp
            changed = 1
        End If
    End If
    Next

Loop Until changed = 0
End Sub

Это работает нормально, но в результате получается что-то вроде этого:

ExampleChart

Каждый набор упорядочен из-за моего вида, но я бы хотел, чтобы все данные были отсортированы по значению оси Y. Я не могу придумать, как это сделать, сохранив при этом данные, разделенные рядами. Есть ли способ отобразить значения оси X на основе соответствующего значения оси Y, а не на основе позиции серии?

1 ответ

Решение

После долгих поисков я нашел комбинацию решений, которые работали для меня, в основном используя информацию по этой ссылке: http://peltiertech.com/chart-with-a-dual-category-axis/

... А также из множества сообщений Stackru, указывающих на то, что это невозможно программно и должно быть выполнено с помощью рабочего листа, который работал для меня. Я заполнил ячейки рабочего листа, как это было сделано в приведенной выше ссылке, за исключением Visual Basic. Затем, после сбора данных, я спрятал лист. Это работает для меня, потому что рабочие листы очищаются каждый раз, когда пользователь начинает заново с новым набором данных. Вот мой код:

Sub Distribution()
Dim runningTotal, seriesNumber, sheetName

seriesNumber = 1
runningTotal = 2

currDist = currDist + 1
sheetName = "DistData" + CStr(currDist)

ActiveWorkbook.Sheets.Add
ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.count)
ActiveSheet.Name = sheetName
ActiveSheet.Visible = True

For j = 0 To UBound(chartLabels)
    If IsEmpty(chartLabels(j)) Then Exit For
    Erase xval
    Erase yval
    ReDim Preserve xval(0 To 0)
    ReDim Preserve yval(0 To 0)
    xval(0) = chartData(0, j, 0)
    yval(0) = chartData(2, j, 0)

    For i = 0 To UBound(chartData, 3) - 1
        If Not IsEmpty(chartData(2, j, i + 1)) Then
            ReDim Preserve xval(0 To i + 1)
            ReDim Preserve yval(0 To i + 1)
            xval(i + 1) = chartData(0, j, i + 1)
            yval(i + 1) = chartData(2, j, i + 1)
        End If
    Next

    Call bubblesortLosses(j, UBound(xval))

    Sheets(sheetName).Select

    Cells(1, seriesNumber + 2) = chartLabels(j)
    Cells(runningTotal, 1) = chartLabels(j)

    For k = 0 To UBound(xval)
        Cells(runningTotal, 2) = xval(k)
        Cells(runningTotal, seriesNumber + 2) = yval(k)
        runningTotal = runningTotal + 1
    Next

    seriesNumber = seriesNumber + 1

Next

ActiveWorkbook.Charts.Add
ActiveChart.ChartArea.Select
With ActiveChart
    .ChartType = xlColumnStacked
    .HasTitle = True
    .ChartTitle.Text = "Ordered Distribution Graph"
    .Axes(xlCategory).TickLabels.MultiLevel = True
    .Axes(xlCategory).HasTitle = True
    .Axes(xlCategory).AxisTitle.Characters.Text = "Item"
    .Axes(xlCategory).CategoryType = xlCategoryScale
    .Axes(xlValue).HasTitle = True
    .Axes(xlValue).AxisTitle.Characters.Text = "Total"
    .Legend.Position = xlLegendPositionBottom
End With

ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.count)
ActiveSheet.Name = "Distribution " + CStr(currDist)

ActiveChart.ChartGroups(1).GapWidth = 10
ActiveChart.ChartGroups(1).Overlap = 100

Sheets(sheetName).Visible = False
Sheets(ActiveWorkbook.Sheets.count).Activate

End Sub

Процедура сортировки пузырьков такая же, как и в вопросе. Окончательный результат для одного из моих тестовых прогонов здесь:

введите описание изображения здесь

Номер изделия указан в списке, но ярлыки категорий вырезаны из-за конфиденциальности. Они будут читать, как в "Серии 1", "Серии 2" и "Серии 3"

Другие вопросы по тегам