遍历行，使用特定列的值为每一行创建图表，直到空白行

Question

我想从工作表的第 6 行开始，向下移动每一行，使用每行的 C、E、G 和 I 列中单元格的值为每一行创建饼图，直到遇到空白行。

到目前为止，我有类似这样的东西来生成第一个图表，但是在尝试循环这个过程时遇到了很多麻烦（目前正在尝试使用 Do-Until-Loop 将当前行#与最后一行的值进行比较第 # 行不为空）

Do

'ValueRange sets the Range of Cells needed to fill each Chart with data
ValueRange = ThisWorkbook.Worksheets("Testplan Überblick").Range(Sheets("Testplan Überblick").Cells(rownumber, 3), Sheets("Testplan Überblick").Cells(rownumber, 5), Sheets("Testplan Überblick").Cells(rownumber, 7), Sheets("Testplan Überblick").Cells(rownumber, 9))


Set Graph = Sheets("Testplan Überblick").ChartObjects.Add(Left:=180, Width:=270, Top:=7, Height:=210)
With Graph
.Chart.SetSourceData Source:=ValueRange
.Chart.ChartType = xlPie
.Chart.HasTitle = True
.Chart.SetElement (msoElementChartTitleAboveChart)
.Chart.ChartTitle.Text = Sheets("Testplan Überblick").Cells(rownumber, 1).Value
.Chart.FullSeriesCollection(1).XValues = TitelrangeBuild
End With

rownumber = rownumber + 1

Loop Until rownumber >= LastFoundRow   'LastFoundRow gives a Long-Value of the last filled Row#

我想我需要一个 For-Each row 方法，但我无法使任何事情起作用，我只能创建 1 个图表

干杯，感谢您的帮助！

编辑：不幸的是，“ValueRange = ...”这一行抛出了一个我似乎无法修复的错误（错误的参数数量）

Answer 1

我会计算最后一行有值的位置，类似 ThisWorkbook.Worksheets("Testplan Überblick").Cells(1048576, 3).End(xlUp).Row 然后从 6 循环到这个值。

为了简单起见，我将您的工作表分配给了 ws，这样可以更轻松地阅读代码。

Sub loop_till_end()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Testplan Überblick")
Dim i As Integer
Dim valuerange As Range
Dim graph As ChartObject
For i = 6 To ws.Cells(10489, 3).End(xlUp).Row
    Set valuerange = Union(ws.Cells(i, 3), ws.Cells(i, 5), ws.Cells(i, 7), ws.Cells(i, 9))
    Set graph = ws.ChartObjects.Add(Left:=(180 + (i - 6) * 270), Width:=270, Top:=7, Height:=210)
    With graph
        .Chart.SetSourceData Source:=valuerange
        .Chart.ChartType = xlPie
        .Chart.HasTitle = True
        .Chart.SetElement (msoElementChartTitleAboveChart)
        .Chart.ChartTitle.Text = ws.Cells(i, 1).Value
    End With
Next
End Sub

它也不会将图表堆叠在一起，而是将它们并排放置。 Left:=180 + (i - 6) * 180

计数器 i 是您的行号。

Answer 2

我认为您已将所有图表添加到同一位置 Set Graph = Sheets("Testplan Überblick").ChartObjects.Add(Left:=180, Width:=270, Top:=7, Height:=210)。它们相互覆盖，让您认为只有一个被创建。您必须为每个循环更改参数 Top 和 Left

遍历行，使用特定列的值为每一行创建图表，直到空白行

Loop through Rows, Create Chart for each row with values from specific columns until Blank row

excel

charts

vba

loops

rows