March 30, 2014

Excel VBAで複数のシートのXYデータを3D参照して散布図をプロット

実験データ、ログのようなものをグラフにすることを考えると、もとのCSVやテキストを束ねたエクセルファイルでは、複数のシートに同じ構造のデータが複数組、並んでいるはず。

そういう時に、データを1シートに纏めることなく、そのままグラフ化するためのマクロ。

1つのシートに複数組のXYデータがある場合
http://foundknownanddone.blogspot.com/2014/03/xx-yexcel-x1y1x2y2-sub.html
 

使い方

  • 作業グループを作る(=複数のワークシートを選ぶ)
  • XYデータに対応する2列のセル範囲を選ぶ
  • マクロを実行する
セル範囲の列をX1、Y1とし、1シート1系列となるように散布図を作成する。

コード


Sub createChartwith3DXYdata()
'複数のシートの同じ位置にXYデータが並んでいるときに、
'シートタブをクリックしながら選んで作業グループを作成し
'XYデータに相当する2列のデータ範囲を選択して
'このマクロを実行すると、各シートのデータを1つの系列として
'散布図を作成します。

    Dim targetSheets As Sheets
    Dim targetRange As Range
    
    Dim dest As String
        
    Dim targetSheet As Worksheet
    Dim i As Integer
    Dim targetSeries As Series
 
     
    Set targetSheets = ActiveWindow.SelectedSheets
    Set targetRange = Selection
     
    'シート名を退避しておく(埋め込みグラフにする時に移動先)
    dest = ActiveSheet.Name
    
    'グラフ作成
    With Charts.Add
        .ChartType = xlXYScatterLines
        .Location Where:=xlLocationAsObject, Name:=dest
            '埋め込みグラフにしたくない場合は上の行を消す
    End With
    
    '系列にデータを設定(データはX、Yの順番で列ごとに並んでる必要あり)
    i = 1
    For Each targetSheet In targetSheets
        If i > ActiveChart.SeriesCollection.Count Then
            Set targetSeries = ActiveChart.SeriesCollection.NewSeries
        Else
            Set targetSeries = ActiveChart.SeriesCollection(i)
        End If

        targetSeries.XValues = targetSheet.Range(targetRange.Address).Columns(1)
        targetSeries.Values = targetSheet.Range(targetRange.Address).Columns(2)
        
        i = i + 1
    Next
     
    '余った系列を削除(セル範囲を選んで開始しているので、勝手に系列が出来てしまう。)
    For i = targetSheets.Count + 1 To ActiveChart.SeriesCollection.Count
        ActiveChart.SeriesCollection(targetSheets.Count + 1).Delete
    Next
End Sub

変更履歴

2014/3/30 初版

No comments :

Post a Comment