回答編集履歴
4
コードを修正しました\(2\)
answer
CHANGED
|
@@ -268,7 +268,7 @@
|
|
|
268
268
|
If Left(strInput, Len(symbol)) = symbol And Right(strInput, Len(symbol)) = symbol Then
|
|
269
269
|
'文字列がsymbolで囲まれている
|
|
270
270
|
UseEnclose = True
|
|
271
|
-
result = Mid(strInput,
|
|
271
|
+
result = Mid(strInput, Len(symbol) + 1, Len(strInput) - Len(symbol) * 2) '前後のシンボルを除去
|
|
272
272
|
result = Replace(result, escape, symbol) 'エスケープの処理
|
|
273
273
|
Else
|
|
274
274
|
'文字列がsymbolで囲まれていない
|
3
コードの修正を行いました
answer
CHANGED
|
@@ -33,11 +33,13 @@
|
|
|
33
33
|
---
|
|
34
34
|
|
|
35
35
|
**追記 2015/11/19**
|
|
36
|
+
**編集 2015/11/20 コードを修正しました**
|
|
36
37
|
グラフのデータ範囲をチェックして、適切でないと判断した場合に範囲を修正するサンプルを書きました。
|
|
37
38
|
末尾の無効(値の入っていないセル)を除外するだけでなく、不足があれば拡張(範囲を拡大)されるようになっています。拡張が不要であれば拡張をしない形に修正できます。
|
|
38
39
|
|
|
39
40
|
少し"ごちゃっ"としてしまいましたが、以下のコードで動作確認できています。
|
|
40
41
|
「ChartCheckMain」を実行頂ければ、アクティブなシート上に存在する全てのグラフについて処理をします。
|
|
42
|
+
** 2015/11/20 11:50頃 修正済みのコードです**
|
|
41
43
|
```VBA
|
|
42
44
|
'<summary>
|
|
43
45
|
' アクティブなシート上に存在する全グラフをチェックする
|
|
@@ -58,7 +60,6 @@
|
|
|
58
60
|
Next ChrtObj
|
|
59
61
|
End Sub
|
|
60
62
|
|
|
61
|
-
|
|
62
63
|
'<summary>
|
|
63
64
|
' グラフのデータ範囲をチェックし、無効な範囲を除去
|
|
64
65
|
'</summary>
|
|
@@ -69,6 +70,13 @@
|
|
|
69
70
|
On Error Resume Next
|
|
70
71
|
Err.Clear
|
|
71
72
|
|
|
73
|
+
Const ENCLOSE_SYMBOL As String = "'"
|
|
74
|
+
Const SYMBOL_ESCAPE As String = "''"
|
|
75
|
+
Const ARGS_PATTERN As String = "\((\(.+\)|[^()]*),(\(.+\)|[^()]*),(.+?),(\d+)\)$"
|
|
76
|
+
Const RANGE_PATTERN As String = "^('.+'|[^']+)!([^!]+)$"
|
|
77
|
+
|
|
78
|
+
Dim Regex 'VBScript.RegExp
|
|
79
|
+
Dim Matches 'RegExp.Matches
|
|
72
80
|
Dim SrsCol As SeriesCollection '系列のコレクション
|
|
73
81
|
Dim SrsCnt As Integer '系列数
|
|
74
82
|
Dim SrsIdx As Integer '系列のインデックス
|
|
@@ -78,19 +86,27 @@
|
|
|
78
86
|
Dim SrsLabels As String '項目軸のラベル
|
|
79
87
|
Dim SrsValues As String '値(プロット対象のデータ範囲)
|
|
80
88
|
Dim SrsOrder As String 'オーダー
|
|
81
|
-
Dim Params 'パラメータ(分解用)
|
|
82
89
|
Dim ShtName As String 'データの存在するシート名
|
|
83
90
|
Dim RngStr As String '範囲を示す文字列
|
|
84
91
|
Dim Rng As Range 'Range
|
|
92
|
+
Dim ColEnd As Long 'データ範囲の終端(列)
|
|
85
93
|
Dim NewRng As Range 'チェックによって決定されたデータ範囲
|
|
86
94
|
Dim NewSrsLabels As String 'チェックによって決定されたラベル(SERIESの第2引数)
|
|
87
95
|
Dim NewSrsValues As String 'チェックによって決定された値(SERIESの第3引数)
|
|
88
96
|
Dim NewColumnCnt As Long 'チェックによって決定されたデータ範囲の大きさ(列数)
|
|
89
97
|
Dim NewFormula As String 'チェックによって決定されたFormulaの値
|
|
98
|
+
Dim UseEnclose As Boolean
|
|
90
99
|
|
|
91
100
|
DataRangeChecker = False
|
|
92
101
|
|
|
93
102
|
Debug.Print "=========================================="
|
|
103
|
+
|
|
104
|
+
Set Regex = CreateObject("VBScript.RegExp")
|
|
105
|
+
If Err.Number <> 0 Then
|
|
106
|
+
Debug.Print "> VBScript.RegExpが取得できませんでした"
|
|
107
|
+
Exit Function
|
|
108
|
+
End If
|
|
109
|
+
|
|
94
110
|
Debug.Print "Target Chart : " & ChrtObj.Name
|
|
95
111
|
|
|
96
112
|
Set SrsCol = ChrtObj.Chart.SeriesCollection '系列のコレクションを取得
|
|
@@ -108,12 +124,24 @@
|
|
|
108
124
|
Debug.Print " Formula" & FormulaValue
|
|
109
125
|
|
|
110
126
|
'文字列から情報を抽出
|
|
127
|
+
With Regex
|
|
128
|
+
.Pattern = ARGS_PATTERN
|
|
129
|
+
.IgnoreCase = False
|
|
130
|
+
.Global = True
|
|
111
|
-
|
|
131
|
+
Set Matches = .Execute(FormulaValue)
|
|
112
|
-
SrsName = Replace(Params(0), "=SERIES(", "") '凡例の表示
|
|
113
|
-
SrsLabels = Params(1) '項目軸のラベル
|
|
114
|
-
|
|
132
|
+
End With
|
|
115
|
-
SrsOrder = Replace(Params(3), ")", "") 'オーダー
|
|
116
133
|
|
|
134
|
+
If Matches.Count > 0 Then
|
|
135
|
+
SrsName = Matches(0).SubMatches.Item(0) '凡例の表示
|
|
136
|
+
SrsLabels = Matches(0).SubMatches.Item(1) '項目軸のラベル
|
|
137
|
+
SrsValues = Matches(0).SubMatches.Item(2) '値
|
|
138
|
+
SrsOrder = Matches(0).SubMatches.Item(3) 'オーダー
|
|
139
|
+
Else
|
|
140
|
+
Debug.Print " > 情報の抽出に失敗しました"
|
|
141
|
+
SrsName = SrsLabels = SrsValues = SrsOrder = ""
|
|
142
|
+
GoTo CONTINUE_FOR
|
|
143
|
+
End If
|
|
144
|
+
|
|
117
145
|
Debug.Print " Param(0) = " & SrsName
|
|
118
146
|
Debug.Print " Param(1) = " & SrsLabels
|
|
119
147
|
Debug.Print " Param(2) = " & SrsValues
|
|
@@ -122,18 +150,34 @@
|
|
|
122
150
|
'-------------------------------------
|
|
123
151
|
'SERIESの第3引数(データ範囲)のチェック
|
|
124
152
|
'-------------------------------------
|
|
153
|
+
With Regex
|
|
125
|
-
|
|
154
|
+
.Pattern = RANGE_PATTERN
|
|
155
|
+
.IgnoreCase = False
|
|
156
|
+
.Global = True
|
|
157
|
+
|
|
126
|
-
|
|
158
|
+
Set Matches = .Execute(SrsValues)
|
|
127
|
-
ShtName = Params(0) 'シート名
|
|
128
|
-
|
|
159
|
+
End With
|
|
129
160
|
|
|
161
|
+
If Matches.Count > 0 Then
|
|
162
|
+
ShtName = Matches(0).SubMatches.Item(0) 'シート名
|
|
163
|
+
RngStr = Matches(0).SubMatches.Item(1) 'データ範囲
|
|
164
|
+
|
|
165
|
+
ShtName = CheckEnclose(ShtName, ENCLOSE_SYMBOL, SYMBOL_ESCAPE, UseEnclose)
|
|
166
|
+
|
|
130
167
|
'データ範囲のチェック
|
|
131
168
|
With WBk.Worksheets.Item(ShtName)
|
|
132
169
|
Set Rng = .Range(RngStr)
|
|
133
170
|
Set NewRng = .Range(.Cells(Rng.Row, Rng.Column), .Cells(Rng.Row, Rng.End(xlToRight).Column))
|
|
171
|
+
End With
|
|
134
|
-
|
|
172
|
+
NewColumnCnt = NewRng.Columns.Count
|
|
173
|
+
If UseEnclose = True Then
|
|
174
|
+
NewSrsValues = ENCLOSE_SYMBOL _
|
|
175
|
+
+ Replace(ShtName, ENCLOSE_SYMBOL, SYMBOL_ESCAPE) _
|
|
176
|
+
+ ENCLOSE_SYMBOL _
|
|
177
|
+
+ "!" + NewRng.Address
|
|
178
|
+
Else
|
|
135
179
|
NewSrsValues = ShtName + "!" + NewRng.Address
|
|
136
|
-
End
|
|
180
|
+
End If
|
|
137
181
|
|
|
138
182
|
Else
|
|
139
183
|
'第3引数に!が存在しなかった
|
|
@@ -150,23 +194,39 @@
|
|
|
150
194
|
'-----------------------------------------
|
|
151
195
|
'SERIESの第2引数(項目軸のラベル)をチェック
|
|
152
196
|
'-----------------------------------------
|
|
197
|
+
With Regex
|
|
198
|
+
.Pattern = RANGE_PATTERN
|
|
199
|
+
.IgnoreCase = False
|
|
200
|
+
.Global = True
|
|
201
|
+
Set Matches = .Execute(SrsLabels)
|
|
202
|
+
End With
|
|
203
|
+
|
|
153
|
-
If
|
|
204
|
+
If Matches.Count > 0 Then
|
|
154
|
-
Params = Split(SrsLabels, "!")
|
|
155
|
-
ShtName =
|
|
205
|
+
ShtName = Matches(0).SubMatches.Item(0) 'シート名
|
|
156
|
-
RngStr =
|
|
206
|
+
RngStr = Matches(0).SubMatches.Item(1) 'データ範囲
|
|
207
|
+
|
|
208
|
+
ShtName = CheckEnclose(ShtName, ENCLOSE_SYMBOL, SYMBOL_ESCAPE, UseEnclose)
|
|
157
209
|
|
|
158
210
|
'ラベルの範囲を決定
|
|
159
211
|
With WBk.Worksheets.Item(ShtName)
|
|
160
212
|
Set Rng = .Range(RngStr)
|
|
161
213
|
Set NewRng = .Range(.Cells(Rng.Row, Rng.Column), .Cells(Rng.Row, Rng.Column + NewColumnCnt - 1))
|
|
214
|
+
End With
|
|
215
|
+
If UseEnclose = True Then
|
|
216
|
+
NewSrsLabels = ENCLOSE_SYMBOL _
|
|
217
|
+
+ Replace(ShtName, ENCLOSE_SYMBOL, SYMBOL_ESCAPE) _
|
|
218
|
+
+ ENCLOSE_SYMBOL _
|
|
219
|
+
+ "!" + NewRng.Address
|
|
220
|
+
Else
|
|
162
221
|
NewSrsLabels = ShtName + "!" + NewRng.Address
|
|
163
|
-
End
|
|
222
|
+
End If
|
|
164
223
|
|
|
165
224
|
Else
|
|
166
225
|
'第2引数に!が存在しなかった
|
|
167
226
|
NewSrsLabels = SrsLabels
|
|
168
227
|
End If
|
|
169
228
|
|
|
229
|
+
|
|
170
230
|
'新しくFormulaに設定する文字列を生成
|
|
171
231
|
NewFormula = "=SERIES(" & SrsName & "," & NewSrsLabels & "," & NewSrsValues & "," & SrsOrder & ")"
|
|
172
232
|
|
|
@@ -175,18 +235,49 @@
|
|
|
175
235
|
Debug.Print " " & NewFormula
|
|
176
236
|
|
|
177
237
|
'生成したFormulaの値を系列に適用
|
|
178
|
-
Srs.Formula = NewFormula
|
|
238
|
+
If Err.Number = 0 Then Srs.Formula = NewFormula
|
|
179
|
-
|
|
239
|
+
|
|
180
240
|
CONTINUE_FOR:
|
|
181
|
-
If Err.Number <> 0 Then Exit Function
|
|
182
241
|
|
|
242
|
+
If Err.Number <> 0 Then GoTo EXIT_FUNCTION
|
|
243
|
+
|
|
183
244
|
Next SrsIdx
|
|
184
245
|
|
|
185
|
-
Debug.Print Chr(10) & "> 正常に終了しました" & Chr(10)
|
|
186
246
|
|
|
247
|
+
EXIT_FUNCTION:
|
|
248
|
+
If Err.Number = 0 Then
|
|
249
|
+
Debug.Print Chr(10) & "> 正常に終了しました" & Chr(10)
|
|
187
|
-
|
|
250
|
+
DataRangeChecker = True
|
|
251
|
+
End If
|
|
188
252
|
|
|
253
|
+
Set Regex = Nothing
|
|
189
254
|
End Function
|
|
255
|
+
|
|
256
|
+
'<summay>
|
|
257
|
+
' 指定の文字列がsymbolで囲まれているかチェック
|
|
258
|
+
'</summary>
|
|
259
|
+
'<param name="strInput">チェック対象の文字列</param>
|
|
260
|
+
'<param name="symbol">シンボル</param>
|
|
261
|
+
'<param name="escape">エスケープ</param>
|
|
262
|
+
'<param name="UseEnclose">シンボルで囲まれているかを返す</param>
|
|
263
|
+
'<returns>囲っているシンボルを除去した文字列を返す</returns>
|
|
264
|
+
Function CheckEnclose(strInput As String, symbol As String, escape As String, _
|
|
265
|
+
ByRef UseEnclose As Boolean) As String
|
|
266
|
+
Dim result As String
|
|
267
|
+
|
|
268
|
+
If Left(strInput, Len(symbol)) = symbol And Right(strInput, Len(symbol)) = symbol Then
|
|
269
|
+
'文字列がsymbolで囲まれている
|
|
270
|
+
UseEnclose = True
|
|
271
|
+
result = Mid(strInput, 2, Len(strInput) - Len(symbol) * 2) '前後のシンボルを除去
|
|
272
|
+
result = Replace(result, escape, symbol) 'エスケープの処理
|
|
273
|
+
Else
|
|
274
|
+
'文字列がsymbolで囲まれていない
|
|
275
|
+
UseEnclose = False
|
|
276
|
+
result = strInput
|
|
277
|
+
End If
|
|
278
|
+
|
|
279
|
+
CheckEnclose = result
|
|
280
|
+
End Function
|
|
190
281
|
```
|
|
191
282
|
・データ範囲内に歯抜けが存在する事を想定していない(あいだに空のセルが入らない)
|
|
192
283
|
・プロットする系列のデータは横(列)方向に並んでいる
|
2
コードを一部修正しました
answer
CHANGED
|
@@ -82,7 +82,6 @@
|
|
|
82
82
|
Dim ShtName As String 'データの存在するシート名
|
|
83
83
|
Dim RngStr As String '範囲を示す文字列
|
|
84
84
|
Dim Rng As Range 'Range
|
|
85
|
-
Dim ColEnd As Long 'データ範囲の終端(列)
|
|
86
85
|
Dim NewRng As Range 'チェックによって決定されたデータ範囲
|
|
87
86
|
Dim NewSrsLabels As String 'チェックによって決定されたラベル(SERIESの第2引数)
|
|
88
87
|
Dim NewSrsValues As String 'チェックによって決定された値(SERIESの第3引数)
|
1
サンプルコード等を追加しました
answer
CHANGED
|
@@ -27,4 +27,199 @@
|
|
|
27
27
|
最短の範囲で作るのか(イメージの例なら8日まで)?
|
|
28
28
|
最長の範囲で作るのか(イメージの例なら11日まで)?
|
|
29
29
|
|
|
30
|
-
この辺りの条件が決まっていれば、実現は可能だと思います。
|
|
30
|
+
この辺りの条件が決まっていれば、実現は可能だと思います。
|
|
31
|
+
|
|
32
|
+
|
|
33
|
+
---
|
|
34
|
+
|
|
35
|
+
**追記 2015/11/19**
|
|
36
|
+
グラフのデータ範囲をチェックして、適切でないと判断した場合に範囲を修正するサンプルを書きました。
|
|
37
|
+
末尾の無効(値の入っていないセル)を除外するだけでなく、不足があれば拡張(範囲を拡大)されるようになっています。拡張が不要であれば拡張をしない形に修正できます。
|
|
38
|
+
|
|
39
|
+
少し"ごちゃっ"としてしまいましたが、以下のコードで動作確認できています。
|
|
40
|
+
「ChartCheckMain」を実行頂ければ、アクティブなシート上に存在する全てのグラフについて処理をします。
|
|
41
|
+
```VBA
|
|
42
|
+
'<summary>
|
|
43
|
+
' アクティブなシート上に存在する全グラフをチェックする
|
|
44
|
+
'</summary>
|
|
45
|
+
Sub ChartCheckMain()
|
|
46
|
+
Dim AtvWbk As Workbook
|
|
47
|
+
Dim AtvSht As Worksheet
|
|
48
|
+
Dim ChrtObj As ChartObject
|
|
49
|
+
Dim ChrtCnt As Integer
|
|
50
|
+
Dim ChrtIdx As Integer
|
|
51
|
+
Dim ret As Boolean
|
|
52
|
+
|
|
53
|
+
Set AtvWbk = ActiveWorkbook
|
|
54
|
+
Set AtvSht = AtvWbk.ActiveSheet
|
|
55
|
+
|
|
56
|
+
For Each ChrtObj In AtvSht.ChartObjects
|
|
57
|
+
ret = DataRangeChecker(AtvWbk, ChrtObj)
|
|
58
|
+
Next ChrtObj
|
|
59
|
+
End Sub
|
|
60
|
+
|
|
61
|
+
|
|
62
|
+
'<summary>
|
|
63
|
+
' グラフのデータ範囲をチェックし、無効な範囲を除去
|
|
64
|
+
'</summary>
|
|
65
|
+
'<param name="WBk">Workbook</param>
|
|
66
|
+
'<param name="ChrtObj">チェック対象のChartObject</param>
|
|
67
|
+
'<returns>関数の成否</returns>
|
|
68
|
+
Function DataRangeChecker(ByRef WBk As Workbook, ByRef ChrtObj As ChartObject) As Boolean
|
|
69
|
+
On Error Resume Next
|
|
70
|
+
Err.Clear
|
|
71
|
+
|
|
72
|
+
Dim SrsCol As SeriesCollection '系列のコレクション
|
|
73
|
+
Dim SrsCnt As Integer '系列数
|
|
74
|
+
Dim SrsIdx As Integer '系列のインデックス
|
|
75
|
+
Dim Srs As Series '系列
|
|
76
|
+
Dim FormulaValue As String 'Formulaの値
|
|
77
|
+
Dim SrsName As String '凡例の表示
|
|
78
|
+
Dim SrsLabels As String '項目軸のラベル
|
|
79
|
+
Dim SrsValues As String '値(プロット対象のデータ範囲)
|
|
80
|
+
Dim SrsOrder As String 'オーダー
|
|
81
|
+
Dim Params 'パラメータ(分解用)
|
|
82
|
+
Dim ShtName As String 'データの存在するシート名
|
|
83
|
+
Dim RngStr As String '範囲を示す文字列
|
|
84
|
+
Dim Rng As Range 'Range
|
|
85
|
+
Dim ColEnd As Long 'データ範囲の終端(列)
|
|
86
|
+
Dim NewRng As Range 'チェックによって決定されたデータ範囲
|
|
87
|
+
Dim NewSrsLabels As String 'チェックによって決定されたラベル(SERIESの第2引数)
|
|
88
|
+
Dim NewSrsValues As String 'チェックによって決定された値(SERIESの第3引数)
|
|
89
|
+
Dim NewColumnCnt As Long 'チェックによって決定されたデータ範囲の大きさ(列数)
|
|
90
|
+
Dim NewFormula As String 'チェックによって決定されたFormulaの値
|
|
91
|
+
|
|
92
|
+
DataRangeChecker = False
|
|
93
|
+
|
|
94
|
+
Debug.Print "=========================================="
|
|
95
|
+
Debug.Print "Target Chart : " & ChrtObj.Name
|
|
96
|
+
|
|
97
|
+
Set SrsCol = ChrtObj.Chart.SeriesCollection '系列のコレクションを取得
|
|
98
|
+
SrsCnt = SrsCol.Count
|
|
99
|
+
Debug.Print "Series.Count : " & CStr(SrsCnt)
|
|
100
|
+
|
|
101
|
+
'引数で受け取ったChrtObjが無効であれば関数を抜ける
|
|
102
|
+
If Err.Number <> 0 Then Exit Function
|
|
103
|
+
|
|
104
|
+
'全ての系列についてチェック
|
|
105
|
+
For SrsIdx = 1 To SrsCnt
|
|
106
|
+
Set Srs = SrsCol.Item(SrsIdx)
|
|
107
|
+
FormulaValue = Srs.Formula
|
|
108
|
+
Debug.Print Chr(10) & "Series[" & CStr(SrsIdx) & "]"
|
|
109
|
+
Debug.Print " Formula" & FormulaValue
|
|
110
|
+
|
|
111
|
+
'文字列から情報を抽出
|
|
112
|
+
Params = Split(FormulaValue, ",")
|
|
113
|
+
SrsName = Replace(Params(0), "=SERIES(", "") '凡例の表示
|
|
114
|
+
SrsLabels = Params(1) '項目軸のラベル
|
|
115
|
+
SrsValues = Params(2) '値
|
|
116
|
+
SrsOrder = Replace(Params(3), ")", "") 'オーダー
|
|
117
|
+
|
|
118
|
+
Debug.Print " Param(0) = " & SrsName
|
|
119
|
+
Debug.Print " Param(1) = " & SrsLabels
|
|
120
|
+
Debug.Print " Param(2) = " & SrsValues
|
|
121
|
+
Debug.Print " Param(3) = " & SrsOrder
|
|
122
|
+
|
|
123
|
+
'-------------------------------------
|
|
124
|
+
'SERIESの第3引数(データ範囲)のチェック
|
|
125
|
+
'-------------------------------------
|
|
126
|
+
If InStr(SrsValues, "!") > 0 Then
|
|
127
|
+
Params = Split(SrsValues, "!")
|
|
128
|
+
ShtName = Params(0) 'シート名
|
|
129
|
+
RngStr = Params(1) 'データ範囲
|
|
130
|
+
|
|
131
|
+
'データ範囲のチェック
|
|
132
|
+
With WBk.Worksheets.Item(ShtName)
|
|
133
|
+
Set Rng = .Range(RngStr)
|
|
134
|
+
Set NewRng = .Range(.Cells(Rng.Row, Rng.Column), .Cells(Rng.Row, Rng.End(xlToRight).Column))
|
|
135
|
+
NewColumnCnt = NewRng.Columns.Count
|
|
136
|
+
NewSrsValues = ShtName + "!" + NewRng.Address
|
|
137
|
+
End With
|
|
138
|
+
|
|
139
|
+
Else
|
|
140
|
+
'第3引数に!が存在しなかった
|
|
141
|
+
NewSrsValues = SrsValues
|
|
142
|
+
End If
|
|
143
|
+
|
|
144
|
+
'現在のデータ範囲とチェックによって決定されたデータ範囲を比較
|
|
145
|
+
If SrsValues = NewSrsValues Then
|
|
146
|
+
'一致した場合は次の系列へ
|
|
147
|
+
Debug.Print " > データ範囲の変更は行われませんでした"
|
|
148
|
+
GoTo CONTINUE_FOR
|
|
149
|
+
End If
|
|
150
|
+
|
|
151
|
+
'-----------------------------------------
|
|
152
|
+
'SERIESの第2引数(項目軸のラベル)をチェック
|
|
153
|
+
'-----------------------------------------
|
|
154
|
+
If InStr(SrsLabels, "!") > 0 Then
|
|
155
|
+
Params = Split(SrsLabels, "!")
|
|
156
|
+
ShtName = Params(0) 'シート名
|
|
157
|
+
RngStr = Params(1) 'ラベル範囲
|
|
158
|
+
|
|
159
|
+
'ラベルの範囲を決定
|
|
160
|
+
With WBk.Worksheets.Item(ShtName)
|
|
161
|
+
Set Rng = .Range(RngStr)
|
|
162
|
+
Set NewRng = .Range(.Cells(Rng.Row, Rng.Column), .Cells(Rng.Row, Rng.Column + NewColumnCnt - 1))
|
|
163
|
+
NewSrsLabels = ShtName + "!" + NewRng.Address
|
|
164
|
+
End With
|
|
165
|
+
|
|
166
|
+
Else
|
|
167
|
+
'第2引数に!が存在しなかった
|
|
168
|
+
NewSrsLabels = SrsLabels
|
|
169
|
+
End If
|
|
170
|
+
|
|
171
|
+
'新しくFormulaに設定する文字列を生成
|
|
172
|
+
NewFormula = "=SERIES(" & SrsName & "," & NewSrsLabels & "," & NewSrsValues & "," & SrsOrder & ")"
|
|
173
|
+
|
|
174
|
+
Debug.Print Chr(10) & " [Formula]"
|
|
175
|
+
Debug.Print " " & FormulaValue
|
|
176
|
+
Debug.Print " " & NewFormula
|
|
177
|
+
|
|
178
|
+
'生成したFormulaの値を系列に適用
|
|
179
|
+
Srs.Formula = NewFormula
|
|
180
|
+
|
|
181
|
+
CONTINUE_FOR:
|
|
182
|
+
If Err.Number <> 0 Then Exit Function
|
|
183
|
+
|
|
184
|
+
Next SrsIdx
|
|
185
|
+
|
|
186
|
+
Debug.Print Chr(10) & "> 正常に終了しました" & Chr(10)
|
|
187
|
+
|
|
188
|
+
DataRangeChecker = True
|
|
189
|
+
|
|
190
|
+
End Function
|
|
191
|
+
```
|
|
192
|
+
・データ範囲内に歯抜けが存在する事を想定していない(あいだに空のセルが入らない)
|
|
193
|
+
・プロットする系列のデータは横(列)方向に並んでいる
|
|
194
|
+
・末尾(右端)側の適切でない範囲を修正するのみで先頭(左端)側の修正はしない
|
|
195
|
+
・データ範囲の指定が連続していて"とびとび(不連続)"の指示を想定していない
|
|
196
|
+
・ブックを跨いだデータ範囲の指定が存在しない(回避策はあり)
|
|
197
|
+
などの前提になっていますので、この前提で問題があるようでしたら教えてください。
|
|
198
|
+
# 4番目の「連続でない」状況があると結構やっかいになりますが、他はそんなに難易度高くないです。
|
|
199
|
+
|
|
200
|
+
一応、質問文中で頂いているコードの中から呼び出せるように「引数で指定された単一のグラフについて処理をする」機能として関数化しました。
|
|
201
|
+
|
|
202
|
+
以下のように書いてあげれば、変更処理の前にデータ範囲の修正ができます。
|
|
203
|
+
**DataRangeChecker(<グラフの存在するワークブック>, <対象とするグラフ>)**
|
|
204
|
+
```VBA
|
|
205
|
+
Sub graph_change()
|
|
206
|
+
'省略
|
|
207
|
+
For j = 1 To ws.ChartObjects.Count
|
|
208
|
+
|
|
209
|
+
'正常に処理を完了したか?をTrue/Falseで返すように作りましたが、
|
|
210
|
+
'戻り値が不要であれば、コメント側のようにCallで呼んでもらっても良いと思います。
|
|
211
|
+
ret = DataRangeChecker(wb, ws.ChartObjects(j)) ' <--------------------------
|
|
212
|
+
'Call DataRangeChecker(wb, ws.ChartObjects(j))
|
|
213
|
+
|
|
214
|
+
With ws.ChartObjects(j).Chart
|
|
215
|
+
'省略
|
|
216
|
+
```
|
|
217
|
+
|
|
218
|
+
大量にDebug.Printを入れてますが、確認用です。最終的なコードからは該当行を削除してもらって構いません。
|
|
219
|
+
|
|
220
|
+
コードの実行前と実行後のスクリーンショットを貼り付けておきます。
|
|
221
|
+
[実行前]
|
|
222
|
+
|
|
223
|
+
|
|
224
|
+
[実行後]
|
|
225
|
+
|