[[20200821103718]]　『各シートにグラフ範囲にしたいセルがあります。(メx（うさぎたん）　ページの最後に飛ぶ

『各シートにグラフ範囲にしたいセルがあります。(マクロ)』（うさぎたん）

各シートにグラフ範囲にしたいセルがあります。
どうやってつくったらいいか考えてもわかりません。

グラフの中身なのですが、
タイトル各シート範囲C16　中身の範囲B13～K13
グラフの凡例はB1～K1

シートの枚数は5～sheetcount

マクロで積み上げグラフをつくるときに
対象のセルをコピーペーストで一つのシートに一か所にまとめてから範囲指定しましたが
動作がかなり重くなってしまって改善したいのです。

Formula で範囲指定した方がいいか。。それとも。。SetSourceData??

お手数ですがよろしくお願いします

＜使用 Excel：Excel2019、使用 OS：unknown ＞

タイトルと書いてしまいましたが軸ラベルのことです。
グラフっでいうところの　凡例は系列です。
（うさぎたん） 2020/08/21(金) 11:10

動作が重くなってしまったというマクロコードを示すことは可能ですか？
sheetが極端に多いとかではなければ、
一つのシートにコピペしてからグラフにするという方法で
そんなに重くなるとは思えないのですが……。

また、シート数はどのくらいなのでしょうか？
（DS） 2020/08/21(金) 15:21

DS様ありがとうございます。
コードは他ファイルとリンクしていますので、SD様が動かすとエラーになってしまいますが参考にコードを貼り付けます。

        'グラフの元（集計）------------------------------------------------------------------------------------------
        ww = 2
        kkko = 1
        kkk = 8
        kkkL = 9

        JJO = Workbooks("外観マクロ0.xlsm").Worksheets("設定とデーター登録").Cells(Rows.Count, 9).End(xlUp).Row

         For gigi = 2 To JJO

         Workbooks("外観マクロ0.xlsm").Activate
         L = Worksheets("設定とデーター登録").Cells(ww, 9).Value

         llll = Worksheets(L).Range("A16").Value

         Application.Calculate '再計算
         cc = Worksheets("グラフの元（集計）").Cells(Rows.Count, 8).End(xlUp).Row '型式号車
         cc = cc + 1

         '型式
         Worksheets(L).Range("C16").Copy
         Worksheets("グラフの元（集計）").Activate
         Worksheets("グラフの元（集計）").Cells(cc, 8).PasteSpecial Paste:=xlPasteValues

         aaaaa = Worksheets("グラフの元（集計）").Cells(cc, 8).Value & "_" & llll
         ActiveCell = aaaaa

        '手直し時間
        Worksheets(L).Range("M13").Copy
        Worksheets("グラフの元（集計）").Cells(cc, 19).PasteSpecial Paste:=xlPasteValues

        '欠点合計
        Worksheets(L).Range("B13:K13").Copy
        Worksheets("グラフの元（集計）").Cells(cc, 9).PasteSpecial Paste:=xlPasteValues

つづく

（うさぎたん） 2020/08/24(月) 09:03

        ww = ww + 1
           Next gigi

        '型式ラベル
        Worksheets("グラフの元（集計）").Range("H1").Value = "型式"

        '時間ラベル
        Worksheets("グラフの元（集計）").Range("S1").Value = "手直し時間"

        '欠点ラベル
        Worksheets(L).Range("B1:K1").Copy
        Worksheets("グラフの元（集計）").Cells(1, 9).PasteSpecial Paste:=xlPasteValues

' グラフの中身を作る -----------------------------------------------------------------------------------------------------------------------------

       Workbooks("集計グラフ.xlsx").Activate
       Range("A1").Select

       ' 手直し時間と欠点個数のグラフを作る
        Dim chartObj  As Object

        strPath = ThisWorkbook.Path

        Set chartObj = ActiveSheet.ChartObjects.Add(10, 20, 250, 300)
        With chartObj
        Dim rangeWidth: rangeWidth = Range("E1:E2").Width
        Dim rangeHeight: rangeHeight = Range("E1:E2").Height

        'サイズ
        .Height = rangeHeight
        .Width = rangeWidth
        '配置
        .Left = Range("E1").Left
        .Top = Range("E1").Top

         End With

        'グラフの中身
        With chartObj.Chart
        .ApplyChartTemplate (strPath & "\Charts\型式別欠点可視化グラフ.crtx")  'フォーマットを引っ張ってくる

        GHJ = Workbooks("外観マクロ0.xlsm").Worksheets("グラフの元（集計）").Cells(1, Columns.Count).End(xlToLeft).Column '何回繰り返すか取得
        GHJ = GHJ - 1
        For uuu = kkk To GHJ
        '範囲j定義
        j = Workbooks("外観マクロ0.xlsm").Worksheets("グラフの元（集計）").Cells(Rows.Count, 8).End(xlUp).Row
        jj = 2

        '始まり
        P = Cells(jj, kkk).Address '型式アドレス取得
        P2 = Cells(jj, kkkL).Address '欠点種類

        '終わり
        Cells(j, kkk).Select: P1 = ActiveCell.Address '型式
        Cells(j, kkkL).Select: PP2 = ActiveCell.Address '欠点種類
        '各タイトル
        tyty = Cells(1, kkkL).Address

        'ソース
         .SeriesCollection(kkko).Formula = _
            "=SERIES('[外観マクロ0.xlsm]グラフの元（集計）'! " & tyty & ",'[外観マクロ0.xlsm]グラフの元（集計）'!" & P1 & ":" & P & ",'[外観マクロ0.xlsm]グラフの元（集計）'!" & PP2 & ":" & P2 & ",1)"

                 kkkL = kkkL + 1
                 kkko = kkko + 1

           Next uuu

（うさぎたん） 2020/08/24(月) 09:06

グラフはの範囲は各シートからコピーペして一つのシートにまとめてからアドレスではじめと終わりを取得して変数に変えて.Formula に入れています。

シートの枚数は未定が目安は65枚ぐらいです。
よろしくお願いします。。

（うさぎたん） 2020/08/24(月) 09:11

こちらのマクロは重いというだけで動いていたのでしょうか？
また、Sub ～ End Subの中身だけ示したということでよいでしょうか？
（一部怪しいところがあるのですが……）

正直、シートの構造を見ないとマクロの全体像が見えないのですが、
『重い』に対応するのであれば、ScreenUpdatingを切れば、重くなくなるのでは？
それでも重いのであれば、
Workbooks("外観マクロ0.xlsm").Worksheets("グラフの元（集計）")
Workbooks("集計グラフ.xlsx")
の方にコピーしてきて使うとか。

貼られたコードを一部直しましたが、正直、変数の意図が難解で、
それほど極端な直しはしていません。
元のコードが（動いているが、重い、という状態なら）
Application.ScreenUpdating = False/True
を入れるだけでも違うと思いますよ。

 '
Sub てすと()
    Application.ScreenUpdating = False
    'グラフの元（集計）--------------------------
    ww = 2
    kkko = 1
    kkk = 8
    kkkL = 9
    With Workbooks("外観マクロ0.xlsm")
        JJO = .Worksheets("設定とデーター登録").Cells(Rows.Count, 9).End(xlUp).Row
        For gigi = 2 To JJO
            L = .Worksheets("設定とデーター登録").Cells(ww, 9).Value
            cc = .Worksheets("グラフの元（集計）").Cells(Rows.Count, 8).End(xlUp).Row '型式号車
            cc = cc + 1
            '型式
            .Worksheets("グラフの元（集計）").Cells(cc, 8).Value = _
                .Worksheets(L).Range("C16") & "_" & .Worksheets(L).Range("A16").Value
            '手直し時間
            .Worksheets("グラフの元（集計）").Cells(cc, 19).Value = .Worksheets(L).Range("M13")
            '欠点合計
            .Worksheets("グラフの元（集計）").Cells(cc, 9).Resize(1, 10).Value = .Worksheets(L).Range("B13:K13").Value
            ww = ww + 1
        Next gigi

        '型式ラベル
        .Worksheets("グラフの元（集計）").Range("H1").Value = "型式"
        '時間ラベル
        .Worksheets("グラフの元（集計）").Range("S1").Value = "手直し時間"
        '欠点ラベル
        .Worksheets("グラフの元（集計）").Cells(1, 9).Resize(1, 10).Value = Worksheets(L).Range("B1:K1").Value
    End With

    ' グラフの中身を作る -------------------------
    ' 手直し時間と欠点個数のグラフを作る
    Workbooks("集計グラフ.xlsx").Activate
    Dim chartObj  As Object
    strPath = ThisWorkbook.Path
    Set chartObj = ActiveSheet.ChartObjects.Add(10, 20, 250, 300)
    'サイズ
    chartObj.Height = Range("E1:E2").Height
    chartObj.Width = Range("E1:E2").Width
    '配置
    chartObj.Left = Range("E1").Left
    chartObj.Top = Range("E1").Top
    'グラフの中身
    With chartObj.Chart
        .ApplyChartTemplate strPath & "\Charts\型式別欠点可視化グラフ.crtx"  'フォーマットを引っ張ってくる
        GHJ = Workbooks("外観マクロ0.xlsm").Worksheets("グラフの元（集計）").Cells(1, Columns.Count).End(xlToLeft).Column '何回繰り返すか取得
        GHJ = GHJ - 1
        For uuu = kkk To GHJ
            '範囲j定義
            j = Workbooks("外観マクロ0.xlsm").Worksheets("グラフの元（集計）").Cells(Rows.Count, 8).End(xlUp).Row
            jj = 2
            '始まり
            P = Cells(jj, kkk).Address '型式アドレス取得
            P2 = Cells(jj, kkkL).Address '欠点種類
            '終わり
            P1 = Cells(j, kkk).Address '型式
            PP2 = Cells(j, kkkL).Address '欠点種類
            '各タイトル
            tyty = Cells(1, kkkL).Address
            'ソース
            .SeriesCollection(kkko).Formula = _
               "=SERIES('[外観マクロ0.xlsm]グラフの元（集計）'! " & tyty & ",'[外観マクロ0.xlsm]グラフの元（集計）'!" & P1 & ":" & P & ",'[外観マクロ0.xlsm]グラフの元（集計）'!" & PP2 & ":" & P2 & ",1)"
                    kkkL = kkkL + 1
                    kkko = kkko + 1
        Next uuu
    End With
    Application.ScreenUpdating = True
End Sub

（DS） 2020/08/24(月) 16:49

DS様ありがとうございます　
こちらのコードはほんの一部になります。
もっとシンプルに書きたいのですが、、、日々勉強中です。
Application.ScreenUpdating = False/True 　に関してはもっと前のコードに組み込んであります。
本来ファイルごと渡してみて頂きたいぐらいです。。。。

理想の形としては各シートのグラフの範囲をｺﾋﾟﾍﾟで一か所にまとめず取得したいです。
↑このコードの書き方がわからず

今日ふと思いましたが、重い問題は多分シートを行き来し、セルをｺﾋﾟﾍﾟしているからなのではと思っております。

（うさぎたん） 2020/08/24(月) 17:22

拝見したコードを見て、重いことの対策として私ならやることを挙げていきます。

・Application.EnableEvents = False
・Application.Calculation = xlCalculationManual
・Select/Activateをしない
　（セルの値等を操作するとき、SelectやActivateは不要です）

以下は効果がどのくらいあるかわからないですが、
・ワークブック間での参照をやめて、グラフの元（集計）を
　集計グラフ.xlsxにコピーしてから、グラフにする。
・一行ずつグラフに反映させずに、一気に指定する。
　（おっしゃる通り、SetSourceDataを使う）

また、
＞重い問題は多分シートを行き来し、セルをｺﾋﾟﾍﾟしているからなのではと思っております。
重い原因を探るのであれば、ところどころにSTOPをいれて、
どの部分で時間がかかっているのか調べてみては？
例えば、「For uuu = kkk To GHJ」の前の行でSTOPを入れてみる。
（DS） 2020/08/25(火) 05:17

・Application.EnableEvents = False
・Application.Calculation = xlCalculationManual
＞ここにはおいてないですが手前のコードで常に自動計算や画面切り替えのOFFは常に行っています。

・Select/Activateをしない
2つブックを使うのですが並べく抑えてあります

どこで重いかはプうログレスバーで確認しました。
ちょうどグラフを作るセルをｺﾋﾟﾍﾟしている部分でした。

・ワークブック間での参照をやめて、グラフの元（集計）を
　集計グラフ.xlsxにコピーしてから、グラフにする。
＞やってみましたがそこまで変わらず。。

・一行ずつグラフに反映させずに、一気に指定する。
　（おっしゃる通り、SetSourceDataを使う）
＞書き方とかわかるようでしたら教えてください。

宜しくお願いします。

（うさぎたん） 2020/08/25(火) 08:33

書き忘れてしまいましたが、イベントのOFFも行っています。
（うさぎたん） 2020/08/25(火) 08:37

SD様が書いてくれたコードでうごかしてみましたそしたらとってもはやくなりました！！
先ほどはコードを動かせる環境ではなかったため憶測でいってしまいました。すいません。。
違いがわかり自分のコードとみくらべました。短くわかりやすくかつ見やすいコードで感謝しています。
いろいろ勉強になります
貴重なお時間有難うございました！

（うさぎたん） 2020/08/25(火) 14:02

もう解決されているようですので、スルーで構いませんが、
ご自身で時間がかかる箇所を探がしてみてはいかがでしょうか。

 Sub sample()
     Dim t As Double, tt As Double
     tt = Timer
     t = Timer
     '処理1
     Debug.Print "処理1の時間:" & Timer - t
     t = Timer
     '処理2
     Debug.Print "処理2の時間:" & Timer - t
     t = Timer
     '処理3
     Debug.Print "処理3の時間:" & Timer - t
     Debug.Print "トータル時間:" & Timer - tt
 End Sub
イミディエイトウィンドウに秒単位で経過時間を表示します。
（tkit） 2020/08/25(火) 15:57

コメント返信：

[ 一覧(最新更新順) ]

[[20200821103718]] 『各シートにグラフ範囲にしたいセルがあります。(メx（うさぎたん） ページの最後に飛ぶ

[[20200821103718]]　『各シートにグラフ範囲にしたいセルがあります。(メx（うさぎたん）　ページの最後に飛ぶ