VBA 簇状柱状图

VBA Clustered columns graph

提问by Bilfrost

Hi Everyone,

嗨，大家好，

I am trying to write a VBA code to write a chart similar to the one in the image. (What is shown would be sufficient; a couple "nice to haves" are below).

我正在尝试编写 VBA 代码来编写类似于图像中的图表。（显示的内容就足够了；下面有几个“值得拥有”）。

I have used the macro recorder and changed it a little bit to come up with this:

我使用了宏记录器并对其进行了一些更改以得出以下结论：

ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("$B:$i")
ActiveSheet.Shapes("Chart 1").IncrementLeft -111
ActiveSheet.Shapes("Chart 1").IncrementTop 244.8
ActiveSheet.Shapes("Chart 1").ScaleWidth 1.7225, msoFalse, msoScaleFromTopLeft

This gets me everything I need, but also has other data that I don't need. I need to have total cost only (not direct cost) and model cost only (no baseline)

这让我得到了我需要的一切，但也有我不需要的其他数据。我只需要总成本（不是直接成本）和模型成本（没有基线）

I also tried adding each series one by one like this:

我也尝试像这样一个一个地添加每个系列：

ActiveSheet.Shapes.AddChart2(202, xlColumnClustered).Select
With ActiveChart.SeriesCollection.NewSeries
    .XValues = ActiveSheet.Range("D8:i8")
    .Name = ActiveSheet.Range("$d")
    .Values = ActiveSheet.Range("D11:i11")
End With

But that doesn't look at all like what I expected it to look like.

但这看起来完全不像我预期的那样。

Now the nice-haves: - would like to have the data labels written vertically, because I need to keep all 4 decimal places - I don't need to have "model" written under each column; instead, would ike to have the Places written there in an angle - in the legend "Total cost" is shown next to each place; would be better to put it in the title once.

现在好东西： - 想要垂直写入数据标签，因为我需要保留所有 4 个小数位 - 我不需要在每一列下写上“模型”；相反，希望以一个角度写在那里的地方 - 在图例中，“总成本”显示在每个地方旁边；最好把它放在标题中一次。

Any directional guidance on how how I should approach this problem would be greatly appreciated!

任何关于我应该如何解决这个问题的方向性指导将不胜感激！

回答by Bilfrost

For anyone interested, this is what I came up with. It seems to be working fine. The sub is called from another sub, and the inputs are the rows and columns of the data table.

对于任何有兴趣的人，这就是我想出的。它似乎工作正常。sub是从另一个sub调用的，输入是数据表的行和列。

Sub writegraph(startrow As Integer, lastrow As Integer, lastcol As Integer)

Sub writegraph(startrow As Integer, lastrow As Integer, lastcol As Integer)

Range("A3").Select 'otherwise graph can give unpredictable results

Dim i As Integer, j As Integer, g As Integer

Dim objCht As ChartObject

Dim graph(0 To 1) As String
Dim xval As Range
Dim val As Range

graph(0) = "BASELINE"
graph(1) = "MODEL"

'create x values = to each of the products
For j = 4 To lastcol - 1 Step 2
    If xval Is Nothing Then
        Set xval = ActiveSheet.Cells(startrow, j)
    Else
        Set xval = Application.Union(xval, ActiveSheet.Cells(startrow, j))
    End If
Next j

' create the graphs
For g = 0 To UBound(graph)

    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
    ActiveChart.ChartTitle.Text = graph(g) & " (Total cost)"
    ActiveChart.Parent.Name = graph(g)

    'loop through each of the places
    For i = startrow + 2 To lastrow Step 2

        Set val = Nothing

        'loop through each of the products and set the values for the graph
        For j = 4 To lastcol - 1 Step 2
            If val Is Nothing Then
                Set val = ActiveSheet.Cells(i, j + g)
            Else
                Set val = Application.Union(val, ActiveSheet.Cells(i, j + g))
            End If
        Next j

        'write the series for the graph
        With ActiveChart.SeriesCollection.NewSeries
            .XValues = xval
            .Name = ActiveSheet.Cells(i, 2)
            .Values = val
            .ApplyDataLabels
            .DataLabels.Orientation = xlUpward
        End With

    Next i

    'show y axis labels
    ActiveChart.SetElement (msoElementPrimaryValueAxisShow)
    'show legend. (ideally could show plant instead below each bar; not sure how to do that)
    ActiveChart.SetElement (msoElementLegendBottom)

    'reduce the hight of the bar, so the data labels fit
    ActiveChart.PlotArea.Select
    Selection.Height = 110
    Selection.Top = 60

    'add tick marks
    ActiveChart.Axes(xlCategory).MajorTickMark = xlCross
    ActiveChart.Axes(xlCategory).Format.Line.ForeColor.RGB = RGB(0, 0, 0)

    'move the chart on the page
    ActiveSheet.Shapes(graph(g)).Left = ActiveSheet.Cells(lastrow + 2, 3).Left
    ActiveSheet.Shapes(graph(g)).Height = ActiveSheet.Range(Cells(lastrow + 2, 2), Cells(lastrow + 12, 2)).Height
    ActiveSheet.Shapes(graph(g)).Width = ActiveSheet.Range(Cells(lastrow + 2, 3), Cells(lastrow + 2, lastcol)).Width

Next g

    ActiveSheet.Shapes("BASELINE").Top = ActiveSheet.Cells(lastrow + 2, 2).Top
    ActiveSheet.Shapes("MODEL").Top = ActiveSheet.Cells(lastrow + 14, 2).Top

End Sub

结束子