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
Это работает нормально, но в результате получается что-то вроде этого:
Каждый набор упорядочен из-за моего вида, но я бы хотел, чтобы все данные были отсортированы по значению оси 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"