创build一个堆积列图

所以我在这个话题上看到了一些post，但似乎找不到一个办法让它工作。 我的目标是使用VBA创build一个具有以下特征的堆积列图：

1. 每列都基于一行的数据（如E6:P6 ， E7:P7等）。
2. 每个“堆栈部分”是该行中的每一列（位于E4:P4 ）
3. X轴标签位于A列（例如A6 ， A7等）
4. Y轴标签基于数据的dynamic（非特定）。
5. 图表标题（这是很容易的部分 – 我得到这个）。

当然，我也需要显示项目2使用的颜色键的图例。

此图是我通过VBA从原始数据文件生成的30多个报表中的三个需要的报表之一。 报告的最后一步是制作这些图表。 我能够创build堆积图，但最大的问题是，正如上面的数据范围所示，数据中存在差距。 这会导致graphics中的分割部分以及我不想要的其他标签。 本质上我不知道如何格式化graphics，并阅读从“ActiveChart”键入popup的对象窗口。 只是得到了这么多。 如果我知道各种格式化命令（唉，我是新的VBA与Excel），我可以复制它跨我需要的所有图表。

 Dim data As Range Set data = Range("A4:P12") With Charts.Add .ChartType = xlColumnStacked .SetSourceData Source:=data, PlotBy:=xlColumns .HasTitle = True .ChartTitle.Text = "Weekly Report" .Location Where:=xlLocationAsObject, Name:="Sheet1" End With 

我可以做的例子： 输出图

关于空白数据的备注：最左边的空白点是空栏D.还需要能够编辑轴标签。

Answer 1

怎么样这样的事情：

 Public Sub MakeGraph() Dim ws As Excel.Worksheet Dim data As Excel.Range Dim x_axis_labels As Excel.Range Dim series_names As Excel.Range Dim sh As Excel.Shape Dim ch As Excel.Chart Dim I As Long Set ws = Sheet1 Set data = ws.Range("E4:P12") ' Assumes the data are in E4:P12 Set x_axis_labels = ws.Range("A4:A12") ' Assumes the labels are in A4:A12 Set series_names = ws.Range("E2:P2") ' Assumes the labels are in E2:P2 Set sh = ws.Shapes.AddChart Set ch = sh.Chart With ch .ChartType = xlColumnStacked .SetSourceData Source:=data, PlotBy:=xlColumns .HasTitle = True .ChartTitle.Text = "Weekly Report" .Axes(xlCategory, xlPrimary).CategoryNames = x_axis_labels ' Add series names For I = 1 To .SeriesCollection.Count .SeriesCollection(I).Name = series_names.Cells(1, I) Next I End With Set ch = Nothing Set sh = Nothing Set series_names = Nothing Set x_axis_labels = Nothing Set data = Nothing Set ws = Nothing End Sub 

希望有所帮助

Answer 2

我把它丢失的数据将是在E6：P14范围的列？ （我使用的是E6：P14，因为这就是你先说的东西，你的代码和@ xidgel后来说的是E4：P12。）

尝试这个：

 Sub MakeChart() Dim rCats As Range Dim rNames As Range Dim rData As Range Dim iCol As Long Set rCats = ActiveSheet.Range("A6:A14") Set rNames = ActiveSheet.Range("E4:P4") Set rData = ActiveSheet.Range("E6:P14") With ActiveSheet.Shapes.AddChart(xlColumnStacked).Chart Do Until .SeriesCollection.Count = 0 .SeriesCollection(1).Delete Loop For iCol = 1 To rData.Columns.Count If WorksheetFunction.Count(rData.Columns(iCol)) > 0 Then ' it's not blank With .SeriesCollection.NewSeries .Values = rData.Columns(iCol) .XValues = rCats .Name = "=" & rNames.Cells(1, iCol).Address(, , , True) End With End If Next End With End Sub