[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『グラフ作成処理（繰り返し）』（F）
現在、１：データシート、２：グラフシート、３計算シート間でデータの転記等を行い、複数のグラフを作成するマクロを作成しようとしております。
具体的にはデータシートのグループ列（35列分）に入力されたデータ（固有値）ごとにグラフを作成するというもので、グループ１に２つの値を入力、グループ２に１つの値を入力した場合、
合計３つのグラフを作成するという処理です（グループ列分のグラフを作成するわけではありません。）グラフはグラフシートに用意したグラフテンプレートを活用し、グラフ参照範囲に繰り返し計算シートからデータを転記しております。
現状、グループ列に入力されたデータ分のグラフをうまく作成できておらず、お知恵を貸していただけないでしょうか。
以下コードです。
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
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
こんばんは！
とても最後まではお付き合い出来ませんが、ぱっと見、、気になったところを少し。。。
上手くいってないのでしょうけど、、どこが上手く行かないのか？を書いた方がいいと思いますよ？ 解読するのは大変ですから(^^;
まぁ、、気になるところは沢山ありますが、取り敢えず
>If WorksheetFunction.CountA(Range(sh2.Cells(i + 2, 6), sh2.Cells(i + 2, 15))) = 0 Then
こんな記述が沢山出てきますけど、、これって、、、Rangeの前にシートを指定しないとまずくないですか？？？
あと、、0 で何もしないなら、、<>0 とするとか、、、
if で分岐が多いところは。。Select Caseにするとか。。
要は、、データの取得方法に問題があるようですね。
With 句 とか Resize とかを使われた方がいい様に思いました。
もう少し可読性をあげた方がいいと思います。。。(偉そうにすみません。。）
老婆心ながら気になったことだけですけど、、、 いい回答がつくといいですね。。頑張ってくださいね。。
では、、では、、 （SoulMan） 2020/01/18(土) 19:28
＞うまく作成できておらず
と言う点も、こうしたいけれども、こうなってしまう、という説明をしてください。
想像しながらコードを読んでくれ、というのは無しです。
（γ） 2020/01/18(土) 19:41
追記します。 まずは、ご自分でデバッグすることが必要ですね。 これは基本的に他人に委ねる事項ではありません。 やってみたけれど、どうしても不明だということなら、 その事象をきちんと説明してください。
デバッグに関連して、留意点を下記します。
(1)すべての変数を宣言してください。
未宣言の変数はスペルミスがあっても気づきにくいですよ。潜在的なバグの元です。
(2)宣言方法
Dim i, s, t, dc, chc, hmt, 経過年 As Long と書くと、Long型なのは経過年だけです。 i, s, t, dc, chc, hmtはすべて Variant型とみなされます。 ひとつひとつの変数に As Longをつけるか、 Dim i&, s&, t&, dc&, chc&, hmt&, 経過年& などと、Longの型宣言文字 & を使うかです。
(3) ワークシートの特定はもらさないことです。 例えば、 s = Cells(i + 2, 6).End(xlToRight).Column などは、そのときにアクティブなワークシートを指定したことになりますよ。
（γ） 2020/01/18(土) 21:55
ご意見ありがとうございます。
また、返信が遅れ申し訳ございません。
質問に仕方や事象の説明がへたくそですみません。
一度考え直したいと思います。
また、現時点での指摘事項は修正させていただきます。
（F） 2020/01/20(月) 13:11
| 一度考え直したいと思います。 | また、現時点での指摘事項は修正させていただきます。 考えた結果が、別の質問掲示板への再質問なんですか？ 「グラフ作成処理（繰り返し」 https://www.moug.net/faq/viewtopic.php?t=79036
しかも、こちらでの質問とまったく同じ内容での質問ですね。 こちらで皆さんからもらったコメントは、まったく無視ということですか、 指摘事項は修正させていただきます、は口先だけなのですか？ とんでも無いですね。
うまくいかないから内容見てくれと言われても、 意図が説明されていないから、 間違っているのかどうか判別がつきませんよ。
シートのレイアウトを説明するでもなく、 仕様の説明も、上手くいかない内容の説明も無い、 そんなことの解明に時間を割くような奇特な人は極めて稀だと思います。 言っていることわかりますか？
あなたは仕様がわかっているんだから、ステップ実行して、 仕様通りに動作しない理由を突き詰めていったらいいじゃないですか。 それを他人に丸投げするなど、どうかしていますよ。 そこまでは自分がすべきことです。 （γ） 2020/01/21(火) 06:12
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.