テーブル内のデータをループしてグラフに追加する方法

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). 

私はこれらのグラフを作成するために40程度あるので、これをVBAで実行したいと思います。私はここに私のコードを含めていないので、チャートをインポートする以上のVBA用のスクリプトを作るのに苦労している。

私は本当にこれを解決するためのアドバイスや提案を感謝します。

ありがとう:)ヘッダ行の2列目の値を仮定

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 

EDIT - すべて同じチャートで表示されます。

マイナーチェンジを行いました。私はまだデータの各ブロックから個々の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