Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Home : Excel 2016)
グラフ作成処理(繰り返し
投稿日時: 20/01/20 15:27:55
投稿者: ねぎ

現在、1:データシート、2:グラフシート、3計算シート間でデータの転記等を行い、複数のグラフを作成するマクロを作成しようとしております。
具体的にはデータシートのグループ列(35列分)に入力されたデータ(固有値)ごとにグラフを作成するというもので、グループ1に2つの値を入力、グループ2に1つの値を入力した場合、
合計3つのグラフを作成するという処理です(グループ列分のグラフを作成するわけではありません。)グラフはグラフシートに用意したグラフテンプレートを活用し、グラフ参照範囲に繰り返し計算シートからデータを転記しております。
現状、グループ列に入力されたデータ分のグラフをうまく作成できておらず、お知恵を貸していただけないでしょうか。
以下コードです。
Sub グラフ作成()
Dim i, s, t, dc, chc, hmt, 経過年 As Long
Dim 判定mst, 判定 As String
Dim rngtnd, rngtnt, rngt, rng2a, rng1a, rng2d, rng1d As Range
Set sh1 = ThisWorkbook.Sheets("データ")
Set sh2 = ThisWorkbook.Sheets("グラフ")
Set sh3 = ThisWorkbook.Sheets("計算シート")
maxR = sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row
dc = 39
chc = 2
'前回結果を削除
erw = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 14
sh2.Range("F3:O37").ClearContents
sh2.Range("AA41:FT42").ClearContents
sh2.Range("AA44:FT47").ClearContents
sh2.Range(sh2.Rows(55), sh2.Rows(1048576)).Clear
For i = sh2.ChartObjects.Count To 2 Step -1
  sh2.ChartObjects(i).Delete
Next i
    sh3.Range("C27:C630").ClearContents
    sh3.Range("G27:G630").ClearContents
'固有値一覧表を作成
For i = 1 To 35 'グループ列を規定
  'グループ列にデータが入っていない場合は何もしない
  If WorksheetFunction.CountA(Range(sh1.Cells(6, 67 + i), sh1.Cells(maxR, 67 + i))) = 0 Then
  Else
  'グループ列にデータが入っている場合
    s = 0 's→固有値番号
    'グループ一覧表作成
    For t = 6 To maxR
        '固有値がグループ一覧表に記載されていない場合は新しく右に追加、結果入力欄作成
        Set flag = Range(sh2.Cells(2 + i, 6), sh2.Cells(2 + i, 6).Offset(0, s)).Find(sh1.Cells(t, 67 + i), LookIn:=xlValues)
        '固有値個数分のグラフ枠作成
        If flag Is Nothing Then
            s = s + 1
            sh2.Cells(2 + i, 5 + s) = sh1.Cells(t, 67 + i)
            sh2.Range(39 & ":" & 54).Copy
            dc = dc + 16
            sh2.Range(dc & ":" & dc).PasteSpecial
        End If
    Next t
    End If
Next i
'結果を記入
dc = 55
For i = 1 To 35
 If WorksheetFunction.CountA(Range(sh2.Cells(i + 2, 6), sh2.Cells(i + 2, 15))) = 0 Then
 Else
 s = Cells(i + 2, 6).End(xlToRight).Column
    '固有値ごとに結果入力
    For ss = 0 To s
    '計算シートをクリア
    sh3.Range("C27:C630").ClearContents
    sh3.Range("G27:G630").ClearContents
        For t = 6 To maxR
            If sh1.Cells(t, 67 + i) = sh2.Cells(2 + i, 6).Offset(0, ss) Then
                If IsNumeric(sh1.Cells(t, 62).Value) = True Then
                    '経過年、判定を読み込み
                    経過年 = sh3.Cells(14, 4) - sh1.Cells(t, 62)
                    '条件ごとに参照列を変えて判定読み取り
                    If i <= 5 Then
                        判定 = sh1.Cells(t, 17)
                    ElseIf i <= 10 Then
                        判定 = sh1.Cells(t, 23)
                    ElseIf i <= 15 Then
                        判定 = sh1.Cells(t, 29)
                    ElseIf i <= 20 Then
                        判定 = sh1.Cells(t, 35)
                    ElseIf i <= 25 Then
                        判定 = sh1.Cells(t, 41)
                    ElseIf i <= 30 Then
                        判定 = sh1.Cells(t, 47)
                    Else
                        判定 = sh1.Cells(t, 53)
                    End If
                    '判定を数値に変換
                    判定mst = Array("?W", "?V", "?U", "?T") '判定マスタ
                    For hnt = 0 To 3
                        If 判定 = 判定mst(hnt) Then 'hnt 判定数値
                           判定 = hnt + 1
                        End If
                    Next hnt
                    If IsNumeric(判定) = True Then
                        'グラフシートに経過年数、判定を記入
                         sh3.Cells(21 + t, 3) = 経過年
                         sh3.Cells(21 + t, 7) = 判定
                    End If
                End If
            End If
         Next t
        '計算シート表中の各数値転記
        sh3.Range("F16:k23").Copy
        sh2.Range("N" & dc + 4).PasteSpecial Paste:=xlPasteValues
        sh3.Range("F8:E12").Copy
        sh2.Range("W" & dc + 7).PasteSpecial Paste:=xlPasteValues
        '計算シートのAとG列転記
        sh3.Range("C27:C630").Copy
        sh2.Range("AA" & dc + 2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        sh3.Range("G27:G630").Copy
        sh2.Range("AA" & dc + 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        '計算シートのグラフ用データ転記
        sh3.Range("O27:O176").Copy
        sh2.Range("AA" & dc + 5).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        sh3.Range("AC27:AC176").Copy
        sh2.Range("AA" & dc + 7).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        sh3.Range("AS27:AS176").Copy
        sh2.Range("AA" & dc + 6).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        sh3.Range("BG27:BG176").Copy
        sh2.Range("AA" & dc + 8).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        'グループ欄を記入
        If i <= 5 Then
          sh2.Cells(dc + 1, 3) = "A"
        ElseIf i <= 10 Then
          sh2.Cells(dc + 1, 3) = "B"
        ElseIf i <= 15 Then
          sh2.Cells(dc + 1, 3) = "C"
        ElseIf i <= 20 Then
          sh2.Cells(dc + 1, 3) = "D"
        ElseIf i <= 25 Then
          sh2.Cells(dc + 1, 3) = "E"
        ElseIf i <= 30 Then
          sh2.Cells(dc + 1, 3) = "F"
        Else
          sh2.Cells(dc + 1, 3) = "G"
        End If
        'グループ番号転記
        sh2.Cells(dc + 1, 6) = sh2.Cells(i + 2, 4).Value & sh2.Cells(i + 2, 5).Value
        '固有値転記
        sh2.Cells(dc + 1, 8) = sh2.Cells(2 + i, 6 + ss)
        'グラフ作成
            sh2.Activate
            sh2.ChartObjects(1).Select
            sh2.ChartObjects(1).Copy
            sh2.Cells(2, 16).Select
            sh2.Paste
            'グラフ名を設定
            chn = Cells(dc + 1, 3) & "_" & sh2.Cells(dc + 1, 6) & "_" & sh2.Cells(dc + 1, 8)
            sh2.ChartObjects(chc).Name = chn
            'データの範囲設定
            Set rngtnt = Range(sh2.Cells(dc + 2, 27), sh2.Cells(dc + 2, 27).End(xlToRight))
            Set rngtnd = Range(sh2.Cells(dc + 3, 27), sh2.Cells(dc + 3, 27).End(xlToRight))
            Set rngt = Range(sh2.Cells(dc + 4, 27), sh2.Cells(dc + 4, 27).End(xlToRight))
            Set rng2a = Range(sh2.Cells(dc + 5, 27), sh2.Cells(dc + 5, 27).End(xlToRight))
            Set rng2d = Range(sh2.Cells(dc + 6, 27), sh2.Cells(dc + 6, 27).End(xlToRight))
            Set rng1a = Range(sh2.Cells(dc + 7, 27), sh2.Cells(dc + 7, 27).End(xlToRight))
            Set rng1d = Range(sh2.Cells(dc + 8, 27), sh2.Cells(dc + 8, 27).End(xlToRight))
            With sh2.ChartObjects(chn).Chart
            .FullSeriesCollection(1).Name = "=""結果"""
            .FullSeriesCollection(1).XValues = rngtnt
            .FullSeriesCollection(1).Values = rngtnd
            .FullSeriesCollection(2).Name = "=""二次式"""
            .FullSeriesCollection(2).XValues = rngt
            .FullSeriesCollection(2).Values = rng2a
            .FullSeriesCollection(3).Name = "=""一次式"""
            .FullSeriesCollection(3).XValues = rngt
            .FullSeriesCollection(3).Values = rng1a
            .FullSeriesCollection(4).Name = "=""二次式(a)"""
            .FullSeriesCollection(4).XValues = rngt
            .FullSeriesCollection(4).Values = rng2d
            .FullSeriesCollection(5).Name = "=""一次式(b)"""
            .FullSeriesCollection(5).XValues = rngt
            .FullSeriesCollection(5).Values = rng1d
            End With
            sh2.ChartObjects(1).Select
            sh2.ChartObjects(1).Copy
            sh2.ChartObjects(chc).Activate
            sh2.ChartObjects(chc).Select
             sh2.PasteSpecial Format:=2
            'グラフを移動
            With sh2.ChartObjects(chn)
            .Top = sh2.Cells(dc + 3, 2).Top
            .Left = sh2.Cells(dc + 3, 2).Left
            End With
        chc = chc + 1
        dc = dc + 16
    Next ss
  End If
Next i
 MsgBox "終了しました。"
End Sub

回答
投稿日時: 20/01/20 17:45:56
投稿者: mattuwan44

学校からこちらに移られたのですね。
皆さん、巡回してますのでそういうのはすぐわかります。
回答者の面子が変われば何か違ったアイデアが出てくるかもしれませんが、
基本どこでも言われることは同じかと。。。
 
 >現状、グループ列に入力されたデータ分のグラフをうまく作成できておらず
 
上手くできない。
という説明はあいまいです。
 
どうやりたいが、どうなってしまう。
くらいは説明しましょう。
グループ列とグループ1とかグループ2とかの関連がよくわかりません。
 
>グループ1に2つの値を入力、グループ2に1つの値を入力した場合、
>合計3つのグラフを作成するという処理です
グループ1に2列分、グループ2が1列分ってことでしょうか?
で、それらを1つのグラフに3系列入れるってことですか?
全部の列を系列で設定しておけば、空欄は描写しないと思うので、
グラフがどうとか考えなくて、値の転記だけでよくなりませんか?
あと、計算もシート上でさせてしまえば、
マクロの出番は無いような気もしますが。。。。
 
あと、これだけのコード量で、
読んでわかって下さいというのも、少し難しい気がします。
やはり動かしてみながら、1行1行確認するしかないかと思います。
そうなると、サンプルのデータが必要になります。
 
ステップ実行はされてみましたか?

トピックに返信