遍历多个长度不同的表

Question

我有以下 table：

还有一个循环遍历 table 的第一部分（第 6-7 行）的宏，以便在右侧创建 Pie-Charts。我现在的目标是也自动循环遍历所有其他 table。下一个将在第 11 行并为该行创建一个新的饼图，然后是下一个 table（第 15-16 行）等等。每个 table 的 header 总是红色的。问题是 tables 的长度不同，这意味着例如在 table1 ("Build", A5:K7) 中可以有 2 行像这里或 50，但每个是时候每行需要一个饼图了。

目前我有以下表 1 的工作代码（“构建”A6:K79）自动创建 2 个饼图，但我不确定如何为 table 上的所有 table 创建一个循环=24=].

Dim rownumber As Integer
Dim LabelRange As Range
Dim ValueRange As Range
Dim Chart As ChartObject
Dim LeftIndent As Long
Dim TopIndent As Long
Dim InhaltsRangeString As String
Dim LetzteZeile As Long

'Intialpositionen für Graphen
LeftIndent = 726
TopIndent = 60
rownumber = 6 'Anfang der Buildtabelle in Reihe 6 (Spalte 1)


Set LabelRange = ThisWorkbook.Worksheets("Testplan Überblick").Range("C5, E5, G5, I5")
Set TPsheet = Worksheets("Testplan Überblick")
Set ValueRange = Union(TPsheet.Cells(rownumber, 3), TPsheet.Cells(rownumber, 5), TPsheet.Cells(rownumber, 7), TPsheet.Cells(rownumber, 9))


'Loop through table 1 which always starts at row 6 (unlike the others which have no set starting point cause the ones before can vary in length!)

For rownumber = 6 To LetzteZeileFunktion Step 1 '"LetzteZeileFunktion" gives me the long value of the last row filled in table 1 

Set Chart = Sheets("Testplan Überblick").ChartObjects.Add(Left:=180, Width:=270, Top:=7, Height:=210)

With Chart
.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 = LabelRange
.Left = LeftIndent
.Top = TopIndent
.Name = Sheets("Testplan Überblick").Cells(rownumber, 1).Value
End With

TopIndent = TopIndent + 225
Next rownumber

End Sub

任何关于如何循环遍历所有 table 的想法，即使它们的长度（填充图表内容的行数）可能都不同，我们将不胜感激！干杯

Answer 1

使用其中一个 headers 中的文本来标识数据行的开始，并使用 A 列中的空白来结束。我在 B 列中使用了“测试数量”。

Option Explicit

Sub CreateCharts()

    Const DATA = "Testplan Überblick"
    Const ROW_START = 5
    Const POSN_LEFT = 726
    Const POSN_TOP = 60
    Const COL = "B"
    Const HEADER = "testfall qty"

    Dim wb As Workbook, ws As Worksheet
    Dim rngLabel As Range, rngValue As Range
    Dim iRow As Long, iLastRow As Long, count As Integer
    Dim oCht As ChartObject, sColA As String, bflag As Boolean
    bflag = False

    Set wb = ThisWorkbook
    Set ws = wb.Sheets(DATA)
    ' scan down the sheet
    iLastRow = ws.Cells(Rows.count, "A").End(xlUp).Row
    For iRow = ROW_START To iLastRow
        ' look for Testfall Qty as header
        sColA = ws.Cells(iRow, 1)
        If LCase(ws.Cells(iRow, COL)) = HEADER Then
           
            'set ranges
            Set rngLabel = ws.Range("C1, E1, G1, I1").Offset(iRow - 1)
            bflag = True

        ElseIf Len(sColA) > 0 And bflag Then
            ' create chart
            Set rngValue = ws.Range("C1, E1, G1, I1").Offset(iRow - 1)
            
            Set oCht = ws.ChartObjects.Add(Left:=180, _
                      Width:=270, Top:=7, Height:=210)
            With oCht
                .Left = POSN_LEFT
                .Top = POSN_TOP + (count * 255)
                .Name = sColA
                With .Chart
                    .SetSourceData Source:=rngValue
                    .SeriesCollection(1).XValues = rngLabel
                    .ChartType = xlPie
                    .HasTitle = True
                    .SetElement msoElementChartTitleAboveChart
                    .ChartTitle.Text = sColA
                End With
            End With
            count = count + 1
        Else
            ' end of chart data
            bflag = False
        End If
    Next
    MsgBox count & " Charts created", vbInformation

End Sub

遍历多个长度不同的表

Looping through multiple tables which vary in length

excel

charts

vba

loops

shapes