Question

我有下表：

还有一个循环遍历表格第一部分（第 6-7 行）的宏，以创建右侧的饼图。我现在的目标是自动循环遍历所有其他表。下一个将在第 11 行并为该行创建一个新的饼图，然后是下一个表（第 15-16 行），依此类推。每个表的标题始终为红色。问题是表格的长度各不相同，这意味着例如在 table1 ("Build", A5:K7) 中可以有 2 行，如此处或 50，但每次我需要每行一个 PieChart。

目前我有以下工作代码用于 Table1（“Build”A6:K79）来自动创建 2 个饼图，但我不确定如何为工作表上的所有表格制作一个循环。

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

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

Answer 1

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

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

循环遍历多个长度不同的表

1 个答案: