Question

我试图使用Excel VBA解决的问题是我要循环并添加到图表中的信息表。

例如，数据文件采用以下格式：

 -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”，则这是一个标题行，其中包含：

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

假设标题行的第二列中的值显示直到下一个标题行的行数（样本数据在...之后有一段时间），这将设置数据，插入图表和颜色要点。

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值。但我认为整个系列会有相同的颜色格式，所以我按系列格式而不是按点格式化。我将每个系列格式化为带有标记的行，而不仅仅是标记。我还使用每个标题行中的第一个单元格作为系列名称，因此这些区分了图例中的系列。最后，我没有重新定位图表，但让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

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

1 个答案: