如何循环遍历 table 中的数据并将其添加到图表中

Question

我试图使用 Excel VBA 解决的问题是 table 我想遍历并添加到图表的信息。

例如数据文件格式如下：

 -696.710022 48 0 
 0 415.853546 2 1
 5 417.769196 2 1
 10 419.684845 2 1
 15 421.600464 2 1
 20 423.516113 2 1
 ......
 -602 48 0 
 0 371.893372 2 1
 5 373.851685 2 1
 10 375.810028 2 1
 15 377.768372 2 1
 20 379.726685 2 1
 ......
 -497.76001 48 0 
 0 323.194183 2 1
 5 325.189819 2 1
 10 327.185486 2 1
 15 329.181152 2 1
 20 331.176819 2 1
 ......
 etc.

在此文件中，如果第 3 列 =“0”，这是一个 header 行，其中：

column 1 = location, 
column 2 = number of points at location, 
column 3 = header flag (i.e. "0")

其余行为数据：

column 1 = X value,
column 2 = Y value,
column 3 = colour of points (i.e. 1 = green, 2 = blue, 3 = red).

我想在 VBA 中运行这个，因为我有 40 个左右的图表要制作。除了导入图表之外，我一直在为 VBA 制作脚本，所以我没有在此处包含我的代码。

我真的很感谢任何关于如何解决这个问题的意见或建议。

谢谢:)

Answer 1

假设 header 行的第二列中的值显示直到下一个 header 行的行数（样本数据......过了一会儿），这将设置上数据，插入图表，给点上色。

Sub DoCharts()
  Dim iRow As Long, nRows As Long, iPt As Long, nPts As Long
  Dim rXVals As Range, rYVals As Range, rColor As Range
  Dim cht As Chart

  With ActiveSheet.UsedRange
    For iRow = 1 To .Rows.Count
      If .Cells(iRow, 3).Value = 0 And Len(.Cells(iRow, 3).Text) > 0 Then
        ' value is zero and cell is not blank

        'define X and Y values
        nPts = .Cells(iRow, 2).Value
        Set rXVals = .Cells(iRow + 1, 1).Resize(nPts)
        Set rYVals = rXVals.Offset(, 1)
        Set rColor = rXVals.Offset(, 2)

        ' chart
        Set cht = ActiveSheet.Shapes.AddChart(xlXYScatter, , .Cells(iRow, 1).Top).Chart

        ' clear existing series
        Do While cht.SeriesCollection.Count > 0
          cht.SeriesCollection(1).Delete
        Loop

        ' add desired series
        With cht.SeriesCollection.NewSeries
          .Values = rYVals
          .XValues = rXVals
        End With

        ' point color
        For iPt = 1 To nPts
          With cht.SeriesCollection(1).Points(iPt)
            Select Case rColor.Cells(iPt)
              Case 1 ' green
                .MarkerForegroundColor = vbGreen ' use nicer colors, of course
                .MarkerBackgroundColor = vbGreen
              Case 2 ' blue
                .MarkerForegroundColor = vbBlue
                .MarkerBackgroundColor = vbBlue
              Case 3 ' red
                .MarkerForegroundColor = vbRed
                .MarkerBackgroundColor = vbRed
            End Select
          End With
        Next
      End If

      cht.HasLegend = False

      iRow = iRow + nPts
    Next
  End With
End Sub

编辑 - 在同一张图表中绘制所有内容。

我做了一些小改动。我仍然使用每个数据块中的单个 X 值。但我假设整个系列都具有相同的颜色格式，所以我按系列而不是按点格式化。我将每个系列格式化为带有标记的行，而不仅仅是标记。我还使用每个 header 行中的第一个单元格作为系列名称，因此这些是图例中区分系列的内容。最后我没有重新定位图表，而是让Excel放在默认位置。

Sub DoOneChart()
  Dim iRow As Long, nRows As Long, iPt As Long, nPts As Long
  Dim rXVals As Range, rYVals As Range, rName As Range
  Dim iColor As Long
  Dim cht As Chart

  With ActiveSheet.UsedRange
    For iRow = 1 To .Rows.Count
      If .Cells(iRow, 3).Value = 0 And Len(.Cells(iRow, 3).Text) > 0 Then
        ' value is zero and cell is not blank

        'define X and Y values
        nPts = .Cells(iRow, 2).Value
        Set rXVals = .Cells(iRow + 1, 1).Resize(nPts)
        Set rYVals = rXVals.Offset(, 1)
        iColor = .Cells(iRow + 1, 3).Value
        Set rName = .Cells(iRow, 1)

        ' chart
        If cht Is Nothing Then
          Set cht = ActiveSheet.Shapes.AddChart(xlXYScatterLines).Chart
          ' clear existing series
          Do While cht.SeriesCollection.Count > 0
            cht.SeriesCollection(1).Delete
          Loop
        End If

        ' add desired series
        With cht.SeriesCollection.NewSeries
          .Values = rYVals
          .XValues = rXVals
          .Name = "=" & rName.Address(, , , True)

          ' series color
          Select Case iColor
            Case 1 ' green
              .MarkerForegroundColor = vbGreen ' use nicer colors, of course
              .MarkerBackgroundColor = vbGreen
              .Border.Color = vbGreen
            Case 2 ' blue
              .MarkerForegroundColor = vbBlue
              .MarkerBackgroundColor = vbBlue
              .Border.Color = vbBlue
            Case 3 ' red
              .MarkerForegroundColor = vbRed
              .MarkerBackgroundColor = vbRed
              .Border.Color = vbRed
          End Select
        End With

      End If

      iRow = iRow + nPts
    Next
    cht.HasLegend = True
  End With
End Sub

如何循环遍历 table 中的数据并将其添加到图表中

How to loop through data in a table and add it to a Chart

excel

charts

vba

series