[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数のグラフで開始日終了日をセルで指定したい』（クララ）
お知恵貸してください。
一つのシートに20項目の日付別データがあり、このデータを基に20種のグラフがあります。
グラフは５つのシートに４つずつ作成しています。
過去一か月＋一週間のグラフを表示するため、毎週20種グラフの開始日・終了日を入力しています。
これをマクロでできないものでしょうか。
一つのグラフでマクロ記録すると下記になりました。
B1 B2 に開始日・終了日を入力し、すべてのグラフの開始日・終了日に反映させるにはどうすればいいでしょう。
【マクロ】
ActiveSheet.ChartObjects("グラフ 8").Activate
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).MinimumScale = 43927 ’4/6
ActiveChart.Axes(xlCategory).MaximumScale = 43962 ’5/11
ActiveChart.Axes(xlCategory).CategoryType = xlCategoryScale
’↑自動的に土日が入るのでこれを避けるため「テキスト基準を自動的に選択する」から「テキスト軸」へ変更
【元データ】
Ａ Ｂ Ｃ Ｄ 〜 JP
――――――――――――――――――――――――――――――――――
１｜ 開始 3/30 （4/6 4/13 B1に毎週一週間ずらしてハンド入力）
２｜ 終了 5/4 （5/11 5/18 B2に毎週一週間ずらしてハンド入力）
３｜
４｜ 4/1 4/2 4/3 〜 12/31
５｜ 基準上 20 20 20 '（基準上・基準下は上限線・下限線を引くためのデータ）
６｜ 基準下 10 10 10
７｜
８｜ 項目１ 10 15 16
９｜ 項目２ 12 11 13
｜ ｜
27｜ 項目20 15 20 13
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
Option Explicit
Sub test()
Dim ws As Worksheet
Dim cho As ChartObject
Dim 開始 As Long
Dim 終了 As Long
開始 = Worksheets("元データ").Range("B1").Value2
終了 = Worksheets("元データ").Range("B2").Value2
For Each ws In Worksheets
For Each cho In ws.ChartObjects
With cho.Chart.Axes(xlCategory)
.CategoryType = xlTimeScale
.MinimumScale = 開始
.MaximumScale = 終了
.CategoryType = xlCategoryScale
End With
Next
Next
End Sub
（マナ） 2020/05/13(水) 11:32
（マナ） 2020/05/13(水) 11:35
Option Explicit
Sub test2()
Dim ws As Worksheet
Dim cho As ChartObject
Dim r As Range
Dim 開始 As Long
Dim 終了 As Long
Dim k As Long
With Worksheets("元データ")
Set r = .Range("C4", .Range("C4").End(xlToRight))
開始 = Application.Match(.Range("B1").Value2 - 0.1, r, 1) + 1
終了 = Application.Match(.Range("B2").Value2, r, 1)
End With
Application.ScreenUpdating = False
For Each ws In Worksheets
For Each cho In ws.ChartObjects
With cho.Chart.ChartGroups(1)
For k = 1 To 開始 - 1
.FullCategoryCollection(k).IsFiltered = True
Next
For k = 開始 To 終了
.FullCategoryCollection(k).IsFiltered = False
Next
For k = 終了 + 1 To .FullCategoryCollection.Count
.FullCategoryCollection(k).IsFiltered = True
Next
End With
Next
Next
End Sub
（マナ） 2020/05/13(水) 14:07
>Set r = .Range("C4", .Range("C4").End(xlToRight))
↓ ↓
Set r = .Range("B4", .Range("B4").End(xlToRight))
（マナ） 2020/05/13(水) 14:12
For k = 開始 To 終了 ↓ For k = 1 To 開始 - 1 ↓ For k = 終了 + 1 To .FullCategoryCollection.Count
（マナ） 2020/05/13(水) 14:24
マナさんありがとうございます。 11:32のコードはどこが×でしたか？ .CategoryType = xlCategoryScale ↓ .CategoryType = xlAutomatic これだけで問題なさそうなのですが…。
いろいろテストしてみます。明日お返事します。
（クララ） 2020/05/13(水) 14:53
＞自動的に土日が入るのでこれを避けるため
（マナ） 2020/05/13(水) 21:42
■14:24の「ループの順番入れ替え」とは下記の意味でよろしいでしょうか。
For k = 1 To 開始 - 1 '1
.FullCategoryCollection(k).IsFiltered = True '2
Next
For k = 開始 To 終了 '3
.FullCategoryCollection(k).IsFiltered = False '4
1234を
3412の意味ですね？
3214と両方トライしたのですがうまくいきませんでした(上記の現象)。
■もしかして
1.日付形式では土日が表示される
2.文字形式では軸の最小値最大値を操作できない
3.文字形式を日付にすると日付やグラフがずれる
これらが相反して無理のような気がしてきました。
もう少しやってみます。
明日ご連絡します。
（クララ） 2020/05/14(木) 12:11
例えば、こんな感じです。
表のセル範囲には名前定義（"グラフデータ"）しておいてください。
Sub test3()
Dim r As Range
Dim 開始
Dim 終了
開始 = 1
終了 = 1
With Worksheets("元データ")
Set r = .Range("B4", .Range("B4").End(xlToRight))
On Error Resume Next
開始 = Application.Match(.Range("B1").Value2 - 0.1, r, 1) + 1
終了 = Application.Match(.Range("B2").Value2, r, 1)
On Error GoTo 0
End With
With Range("グラフデータ")
.ClearContents
r.Cells(開始).Resize(.Rows.Count, 終了 - 開始 + 1).Copy
.Cells(1).PasteSpecial xlPasteValues
End With
End Sub
（マナ） 2020/05/14(木) 20:26
お時間をとっていただいたのに申し訳ないのですが別アプローチで考えてみます。
●日付を文字で持っておき、指定日付（文字）をセル位置で返す
●日付を指定してから文字に変換（今回ヒントをもらったコピーなど）して、指定日付（文字）をセル位置で返す
また、前回グラフを作成しグラフをアクティブにした上でデータ上の範囲 □ をドラッグすればokということも分かったのでこれらで考え直してみます。
いろいろとお力になっていただきありがとうございました。
（クララ） 2020/05/15(金) 10:13
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.