Q&A
いま使っているVBAのコードで該当する部分を貼ってみては
いつもお世話になっております。
エクセルのグラフの範囲一括変更について教えてください。
以前、グラフ範囲を一括で変更かける方法をマクロにて伝授していただいたのですが
そのマクロは現時点で選択範囲が同じであれば「変更前」「変更後」を入力し一括で変更することが
出来るのですが（一発目はきちんと合っていたのに）最近範囲がバラバラになっていることに気が付きました。
現場の進み具合でその月の作業日数が３～４日増加するのでその為の対応なのかもしれませんがそれにしても「CN～DL」までだったり「～DO」までだったり「～DP」までだったりとグラフ範囲がバラバラでグラフを見てもその分左寄りになっていてとってもかっこ悪いものになっています。
この初めの段階で、同じ範囲であれば3日分増えようが２日減ろうが関係なく一括で修正できるのですがスタートの段階で範囲がバラバラなのでせっかく作成したマクロが動きません・・・。
これは、一つ一つ修正するしかないのでしょうか？
マクロ等では、おしりが違う場合一気に揃える技はないでしょうか？
Sub graph_change()
Dim wb As Workbook, ws As Worksheet
Dim str1 As String, str2 As String, i As Integer, j As Integer
str1 = InputBox("変更前の値を入力してください")
If str1 = "" Then Exit Sub
str2 = InputBox("変更後の値を入力してください")
If str2 = "" Then Exit Sub
On Error Resume Next
For Each wb In Workbooks
For Each ws In wb.Worksheets
For j = 1 To ws.ChartObjects.Count
With ws.ChartObjects(j).Chart
For i = 1 To wb.Worksheets.Count
.SeriesCollection.Item(i).Formula = _
Replace(.SeriesCollection.Item(i).Formula, "$" & str1, "$" & str2)
Next i
End With
Next j
Next ws
Next wb
End Sub
回答1件
0
ベストアンサー
こんにちは。
「以前、グラフ範囲を一括で変更」というのは以下を指しているのかと思いました。
違っていれば教えて頂ければと思います。
全シートに対して連続実行する方法について
https://teratail.com/questions/20455
頂いている内容からすると、横軸方向(列)へ日付が配置されているように思えました。
例えば、6行目のデータ最終列は次のような形で求まります。(右方向へ走査して終端を取得)
VBA
1Set rng = Sheet1.Range("D6").End(xlToRight) '仮にD列にデータ先頭があるとして
データに歯抜けが入りうる場合は、たしか一工夫が必要です
私の読み間違えていなければ。という前提の上になってしまいますが
分からない点があります。
恐らくデータの終端(列)が不定になってしまっているのだろうと思いました。
イメージで見ると、11日まである物や8日までしかない物が存在する。
このような状況が
・同シート内でも起こるのか?
・同ブック内のシート毎で異なっているのか?
ほか、シート内で終端(列)が異なった時に
最短の範囲で作るのか(イメージの例なら8日まで)?
最長の範囲で作るのか(イメージの例なら11日まで)?
この辺りの条件が決まっていれば、実現は可能だと思います。
追記 2015/11/19
編集 2015/11/20 コードを修正しました
グラフのデータ範囲をチェックして、適切でないと判断した場合に範囲を修正するサンプルを書きました。
末尾の無効(値の入っていないセル)を除外するだけでなく、不足があれば拡張(範囲を拡大)されるようになっています。拡張が不要であれば拡張をしない形に修正できます。
少し"ごちゃっ"としてしまいましたが、以下のコードで動作確認できています。
「ChartCheckMain」を実行頂ければ、アクティブなシート上に存在する全てのグラフについて処理をします。
** 2015/11/20 11:50頃 修正済みのコードです**
VBA
1'<summary> 2' アクティブなシート上に存在する全グラフをチェックする 3'</summary> 4Sub ChartCheckMain() 5 Dim AtvWbk As Workbook 6 Dim AtvSht As Worksheet 7 Dim ChrtObj As ChartObject 8 Dim ChrtCnt As Integer 9 Dim ChrtIdx As Integer 10 Dim ret As Boolean 11 12 Set AtvWbk = ActiveWorkbook 13 Set AtvSht = AtvWbk.ActiveSheet 14 15 For Each ChrtObj In AtvSht.ChartObjects 16 ret = DataRangeChecker(AtvWbk, ChrtObj) 17 Next ChrtObj 18End Sub 19 20'<summary> 21' グラフのデータ範囲をチェックし、無効な範囲を除去 22'</summary> 23'<param name="WBk">Workbook</param> 24'<param name="ChrtObj">チェック対象のChartObject</param> 25'<returns>関数の成否</returns> 26Function DataRangeChecker(ByRef WBk As Workbook, ByRef ChrtObj As ChartObject) As Boolean 27 On Error Resume Next 28 Err.Clear 29 30 Const ENCLOSE_SYMBOL As String = "'" 31 Const SYMBOL_ESCAPE As String = "''" 32 Const ARGS_PATTERN As String = "\((\(.+\)|[^()]*),(\(.+\)|[^()]*),(.+?),(\d+)\)$" 33 Const RANGE_PATTERN As String = "^('.+'|[^']+)!([^!]+)$" 34 35 Dim Regex 'VBScript.RegExp 36 Dim Matches 'RegExp.Matches 37 Dim SrsCol As SeriesCollection '系列のコレクション 38 Dim SrsCnt As Integer '系列数 39 Dim SrsIdx As Integer '系列のインデックス 40 Dim Srs As Series '系列 41 Dim FormulaValue As String 'Formulaの値 42 Dim SrsName As String '凡例の表示 43 Dim SrsLabels As String '項目軸のラベル 44 Dim SrsValues As String '値(プロット対象のデータ範囲) 45 Dim SrsOrder As String 'オーダー 46 Dim ShtName As String 'データの存在するシート名 47 Dim RngStr As String '範囲を示す文字列 48 Dim Rng As Range 'Range 49 Dim ColEnd As Long 'データ範囲の終端(列) 50 Dim NewRng As Range 'チェックによって決定されたデータ範囲 51 Dim NewSrsLabels As String 'チェックによって決定されたラベル(SERIESの第2引数) 52 Dim NewSrsValues As String 'チェックによって決定された値(SERIESの第3引数) 53 Dim NewColumnCnt As Long 'チェックによって決定されたデータ範囲の大きさ(列数) 54 Dim NewFormula As String 'チェックによって決定されたFormulaの値 55 Dim UseEnclose As Boolean 56 57 DataRangeChecker = False 58 59 Debug.Print "==========================================" 60 61 Set Regex = CreateObject("VBScript.RegExp") 62 If Err.Number <> 0 Then 63 Debug.Print "> VBScript.RegExpが取得できませんでした" 64 Exit Function 65 End If 66 67 Debug.Print "Target Chart : " & ChrtObj.Name 68 69 Set SrsCol = ChrtObj.Chart.SeriesCollection '系列のコレクションを取得 70 SrsCnt = SrsCol.Count 71 Debug.Print "Series.Count : " & CStr(SrsCnt) 72 73 '引数で受け取ったChrtObjが無効であれば関数を抜ける 74 If Err.Number <> 0 Then Exit Function 75 76 '全ての系列についてチェック 77 For SrsIdx = 1 To SrsCnt 78 Set Srs = SrsCol.Item(SrsIdx) 79 FormulaValue = Srs.Formula 80 Debug.Print Chr(10) & "Series[" & CStr(SrsIdx) & "]" 81 Debug.Print " Formula" & FormulaValue 82 83 '文字列から情報を抽出 84 With Regex 85 .Pattern = ARGS_PATTERN 86 .IgnoreCase = False 87 .Global = True 88 Set Matches = .Execute(FormulaValue) 89 End With 90 91 If Matches.Count > 0 Then 92 SrsName = Matches(0).SubMatches.Item(0) '凡例の表示 93 SrsLabels = Matches(0).SubMatches.Item(1) '項目軸のラベル 94 SrsValues = Matches(0).SubMatches.Item(2) '値 95 SrsOrder = Matches(0).SubMatches.Item(3) 'オーダー 96 Else 97 Debug.Print " > 情報の抽出に失敗しました" 98 SrsName = SrsLabels = SrsValues = SrsOrder = "" 99 GoTo CONTINUE_FOR 100 End If 101 102 Debug.Print " Param(0) = " & SrsName 103 Debug.Print " Param(1) = " & SrsLabels 104 Debug.Print " Param(2) = " & SrsValues 105 Debug.Print " Param(3) = " & SrsOrder 106 107 '------------------------------------- 108 'SERIESの第3引数(データ範囲)のチェック 109 '------------------------------------- 110 With Regex 111 .Pattern = RANGE_PATTERN 112 .IgnoreCase = False 113 .Global = True 114 115 Set Matches = .Execute(SrsValues) 116 End With 117 118 If Matches.Count > 0 Then 119 ShtName = Matches(0).SubMatches.Item(0) 'シート名 120 RngStr = Matches(0).SubMatches.Item(1) 'データ範囲 121 122 ShtName = CheckEnclose(ShtName, ENCLOSE_SYMBOL, SYMBOL_ESCAPE, UseEnclose) 123 124 'データ範囲のチェック 125 With WBk.Worksheets.Item(ShtName) 126 Set Rng = .Range(RngStr) 127 Set NewRng = .Range(.Cells(Rng.Row, Rng.Column), .Cells(Rng.Row, Rng.End(xlToRight).Column)) 128 End With 129 NewColumnCnt = NewRng.Columns.Count 130 If UseEnclose = True Then 131 NewSrsValues = ENCLOSE_SYMBOL _ 132 + Replace(ShtName, ENCLOSE_SYMBOL, SYMBOL_ESCAPE) _ 133 + ENCLOSE_SYMBOL _ 134 + "!" + NewRng.Address 135 Else 136 NewSrsValues = ShtName + "!" + NewRng.Address 137 End If 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 With Regex 155 .Pattern = RANGE_PATTERN 156 .IgnoreCase = False 157 .Global = True 158 Set Matches = .Execute(SrsLabels) 159 End With 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 167 'ラベルの範囲を決定 168 With WBk.Worksheets.Item(ShtName) 169 Set Rng = .Range(RngStr) 170 Set NewRng = .Range(.Cells(Rng.Row, Rng.Column), .Cells(Rng.Row, Rng.Column + NewColumnCnt - 1)) 171 End With 172 If UseEnclose = True Then 173 NewSrsLabels = ENCLOSE_SYMBOL _ 174 + Replace(ShtName, ENCLOSE_SYMBOL, SYMBOL_ESCAPE) _ 175 + ENCLOSE_SYMBOL _ 176 + "!" + NewRng.Address 177 Else 178 NewSrsLabels = ShtName + "!" + NewRng.Address 179 End If 180 181 Else 182 '第2引数に!が存在しなかった 183 NewSrsLabels = SrsLabels 184 End If 185 186 187 '新しくFormulaに設定する文字列を生成 188 NewFormula = "=SERIES(" & SrsName & "," & NewSrsLabels & "," & NewSrsValues & "," & SrsOrder & ")" 189 190 Debug.Print Chr(10) & " [Formula]" 191 Debug.Print " " & FormulaValue 192 Debug.Print " " & NewFormula 193 194 '生成したFormulaの値を系列に適用 195 If Err.Number = 0 Then Srs.Formula = NewFormula 196 197CONTINUE_FOR: 198 199 If Err.Number <> 0 Then GoTo EXIT_FUNCTION 200 201 Next SrsIdx 202 203 204EXIT_FUNCTION: 205 If Err.Number = 0 Then 206 Debug.Print Chr(10) & "> 正常に終了しました" & Chr(10) 207 DataRangeChecker = True 208 End If 209 210 Set Regex = Nothing 211End Function 212 213'<summay> 214' 指定の文字列がsymbolで囲まれているかチェック 215'</summary> 216'<param name="strInput">チェック対象の文字列</param> 217'<param name="symbol">シンボル</param> 218'<param name="escape">エスケープ</param> 219'<param name="UseEnclose">シンボルで囲まれているかを返す</param> 220'<returns>囲っているシンボルを除去した文字列を返す</returns> 221Function CheckEnclose(strInput As String, symbol As String, escape As String, _ 222 ByRef UseEnclose As Boolean) As String 223 Dim result As String 224 225 If Left(strInput, Len(symbol)) = symbol And Right(strInput, Len(symbol)) = symbol Then 226 '文字列がsymbolで囲まれている 227 UseEnclose = True 228 result = Mid(strInput, Len(symbol) + 1, Len(strInput) - Len(symbol) * 2) '前後のシンボルを除去 229 result = Replace(result, escape, symbol) 'エスケープの処理 230 Else 231 '文字列がsymbolで囲まれていない 232 UseEnclose = False 233 result = strInput 234 End If 235 236 CheckEnclose = result 237End Function
・データ範囲内に歯抜けが存在する事を想定していない(あいだに空のセルが入らない)
・プロットする系列のデータは横(列)方向に並んでいる
・末尾(右端)側の適切でない範囲を修正するのみで先頭(左端)側の修正はしない
・データ範囲の指定が連続していて"とびとび(不連続)"の指示を想定していない
・ブックを跨いだデータ範囲の指定が存在しない(回避策はあり)
などの前提になっていますので、この前提で問題があるようでしたら教えてください。
4番目の「連続でない」状況があると結構やっかいになりますが、他はそんなに難易度高くないです。
一応、質問文中で頂いているコードの中から呼び出せるように「引数で指定された単一のグラフについて処理をする」機能として関数化しました。
以下のように書いてあげれば、変更処理の前にデータ範囲の修正ができます。
DataRangeChecker(<グラフの存在するワークブック>, <対象とするグラフ>)
VBA
1Sub graph_change() 2 '省略 3 For j = 1 To ws.ChartObjects.Count 4 5 '正常に処理を完了したか?をTrue/Falseで返すように作りましたが、 6 '戻り値が不要であれば、コメント側のようにCallで呼んでもらっても良いと思います。 7 ret = DataRangeChecker(wb, ws.ChartObjects(j)) ' <-------------------------- 8 'Call DataRangeChecker(wb, ws.ChartObjects(j)) 9 10 With ws.ChartObjects(j).Chart 11 '省略
大量にDebug.Printを入れてますが、確認用です。最終的なコードからは該当行を削除してもらって構いません。
コードの実行前と実行後のスクリーンショットを貼り付けておきます。
[実行前]
[実行後]
投稿2015/11/18 07:23
編集2015/11/20 03:35
総合スコア294
sgr-2さん
今日は、載せたコメントがよく消える日です。
質問に、イメージ図を追加しました。
なんで、そうなっているのかは謎なんですがスタート時作成した時は私が作成したのですがきちんと同じ範囲になっていたんです。
上のような感じのデータ範囲のものが３つ縦に並んでいます。
これには、一切関係ないのですがエクセルファイルをたとえば間違えて消してしまった場合どこかにバックファイルか何か残っていないのでしょうか？
追加頂いたイメージを見ました。
"範囲"というのは、「紫色の枠」と「青色の枠」を指しているのかと思ったのですが、
そうすると余計に選択されているという事でしょうか?
# 紫色の枠で3列多い、青色の枠で2列多い
スタート時にはきちんと同じ範囲になっていた点と
>現場の進み具合でその月の作業日数が３～４日増加するのでその為の対応なのかもしれませんが
から考えると、現場の方(?)が手作業で入力した結果、範囲の変更がかかっていた?等の可能性もあるように思えて、判断に難しいところです。。
もし、VBAを実行する方以外もグラフの範囲を変更する可能性があって、かつVBAを実行した時点で正しい範囲の指定になっていれば良い。
# 手を離れている間については、範囲の変更があったとしても仕方が無い
が言えるのであれば、解決可能と思います。
現状のコードは「変更前」と「変更後」の範囲についてVBAを実行する方が手で入力(InputBox)して、Replaceを使って変更させているので期待通りにならない可能性があります。(str1に一致しないのでstr2に変更できない)
であれば、「変更後」だけを入力するように切り替えて処理させれば期待の範囲にする事ができると思います。(Formulaの変更を単純なReplaceでない方法にする)
削除してしまったファイルについてですが、
ローカルの場合、ごみ箱を空にしていても復活できる可能性はあります。
使った事がないので正直なところはっきりとは言えないのですがフリーソフトとしてDataRecoveryなどがあります。
# ただ、フリーソフトをインストールしても良いか?もあると思いますので、それがNGだと すいませんが私には分からないです。
ファイルサーバー(ネットワーク)上であれば、そこでバックアップを取っているか?になります。
後、すいません。質問の内容ですが、私が勘違いしている気がしてきました。。
「修正前」「修正後」を指定して、一括してグラフのデータ範囲を変更する関数とは切り離して、データ範囲がおかしい場合に一括して直してくれる関数を作れると良いって話でしょうか。
Formula等で現在のデータ範囲を特定できるので、そこから無効な範囲(末尾の値が入っていないセル)があれば範囲から除去して、末尾を揃えるというのを書く事で実現できそうです。
少し時間を頂ければサンプルコードを準備できると思います。
このグラフ自体は、まだ未完成なもので作業日が増えるという想定で枠を増やして修正を楽にしてると思われます。
なので、変更修正は問題なしです。
変更前は、どこであろうと関係なく変更後のみを指定すれば問題ないってことですね❗
つまり、str1を削除すれば大丈夫ってことですか？
明日、やってみます。
Sgr-2さん
今のコードを変更して対応出来るのであればそれでもいいかなとも思ったのですが無効な範囲外にあれば～と言うのが出来るのであればサンプルコード欲しいです。
お願いしても良いですか？
cat_junkoさん
無効な範囲を除外して末尾を揃えたデータ範囲に修正するサンプルコードについて考えてみますので、少し時間をください。
sgr-2さん
はい、ありがとうございます。
度重なる早急の回答と対応本当にありがとうございます。
宜しくお願いします。
消してしまったのは、サーバー上のフォルダでした…????
確認したところバックアップ等はとっていないとのことでした。
色々ネットでも調べてみたので明日それをやってみようと思ってます。
サンプルを回答の本文に追記しました。
上手く動かないや分からない等ありましたら、コメント頂ければと思います。
cat_junkoさん
画像の追加ありがとうございます。
追加頂いた画像を見た感覚からですと、私が描いていた「期待する処理」と一致していました。
追記させて頂いたサンプルコードで、目的通りに動くのでは。と思ったのですが、上手くいっていないでしょうか?
期待する結果に修正されないとすれば、グラフ要素である各系列にどのような指定がされているか?を追わないと難しいレベルになってきているように思えます。
期待する結果になっていなくて、かつ以下の内容を貼り付ける事に問題がなければ、コメント等で情報を頂けると助かります。
「イミディエイト ウインドウに出力された内容」
(1)イミディエイト ウインドウが表示されていない場合は、VBAエディタの[表示]メニューから表示できます。
(2)一旦、イミディエイト ウインドウのテキストを全て削除します
(3)サンプルを実行します
(4)イミディエイト ウインドウの内容をコピーペーストします
※この時、シート名や場合によってはブック名が内容に含まれていますので、そのままでない方が良い場合は、AAAやBBBのように意味のない文字に置き換えて頂ければと思います。
Sgr-2さん
ありがとうございます。
事務所で、相変わらずネット環境が悪い状態が続いておりましてスマホでやっと確認しました。
明日、朝一で載せますね。
そうなんです。
期待する処理に、なるはずなんですよね…????
動きを、見ていたら最後の１本が動いていないように思え、それを手作業で移動すると追加画像の下のような感じになります。
明日、イミディエイトウィンドウを載せます。
宜しくお願いします。
sgr-2さん
おはようございます。
下記、イミディウィンドウを貼り付けます。
宜しくお願い致します。
---------------------------------------
==========================================
Target Chart : グラフ 60
Series.Count : 7
Series[1]
Formula=SERIES(,'1914H'!$CN$5:$DI$5,'1914H'!$CN$13:$DO$13,1)
Param(0) =
Param(1) = '1914H'!$CN$5:$DI$5
Param(2) = '1914H'!$CN$13:$DO$13
Param(3) = 1
[Formula]
=SERIES(,'1914H'!$CN$5:$DI$5,'1914H'!$CN$13:$DO$13,1)
=SERIES(,,,1)
==========================================
Target Chart : グラフ 60
Series.Count : 7
Series[1]
Formula=SERIES(,'1914H'!$CN$26:$DO$26,'1914H'!$CN$34:$DO$34,1)
Param(0) =
Param(1) = '1914H'!$CN$26:$DO$26
Param(2) = '1914H'!$CN$34:$DO$34
Param(3) = 1
[Formula]
=SERIES(,'1914H'!$CN$26:$DO$26,'1914H'!$CN$34:$DO$34,1)
=SERIES(,,,1)
==========================================
Target Chart : グラフ 60
Series.Count : 7
Series[1]
Formula=SERIES(,'1914H'!$CN$47:$DO$47,'1914H'!$CN$55:$DI$55,1)
Param(0) =
Param(1) = '1914H'!$CN$47:$DO$47
Param(2) = '1914H'!$CN$55:$DI$55
Param(3) = 1
[Formula]
=SERIES(,'1914H'!$CN$47:$DO$47,'1914H'!$CN$55:$DI$55,1)
=SERIES(,,,1)
==========================================
Target Chart : グラフ 60
Series.Count : 7
Series[1]
Formula=SERIES(,'1914L'!$CN$5:$DO$5,'1914L'!$CN$13:$DO$13,1)
Param(0) =
Param(1) = '1914L'!$CN$5:$DO$5
Param(2) = '1914L'!$CN$13:$DO$13
Param(3) = 1
[Formula]
=SERIES(,'1914L'!$CN$5:$DO$5,'1914L'!$CN$13:$DO$13,1)
=SERIES(,,,1)
==========================================
Target Chart : グラフ 60
Series.Count : 7
Series[1]
Formula=SERIES(,'1914L'!$CN$26:$DO$26,'1914L'!$CN$34:$DO$34,1)
Param(0) =
Param(1) = '1914L'!$CN$26:$DO$26
Param(2) = '1914L'!$CN$34:$DO$34
Param(3) = 1
[Formula]
=SERIES(,'1914L'!$CN$26:$DO$26,'1914L'!$CN$34:$DO$34,1)
=SERIES(,,,1)
==========================================
Target Chart : グラフ 60
Series.Count : 7
Series[1]
Formula=SERIES(,'1914L'!$CN$47:$DO$47,'1914L'!$CN$55:$DO$55,1)
Param(0) =
Param(1) = '1914L'!$CN$47:$DO$47
Param(2) = '1914L'!$CN$55:$DO$55
Param(3) = 1
[Formula]
=SERIES(,'1914L'!$CN$47:$DO$47,'1914L'!$CN$55:$DO$55,1)
=SERIES(,,,1)
==========================================
Target Chart : グラフ 60
Series.Count : 7
Series[1]
Formula=SERIES(,'1914傾斜'!$CN$5:$DO$5,'1914傾斜'!$CN$13:$DO$13,1)
Param(0) =
Param(1) = '1914傾斜'!$CN$5:$DO$5
Param(2) = '1914傾斜'!$CN$13:$DO$13
Param(3) = 1
[Formula]
=SERIES(,'1914傾斜'!$CN$5:$DO$5,'1914傾斜'!$CN$13:$DO$13,1)
=SERIES(,,,1)
==========================================
Target Chart : グラフ 60
Series.Count : 7
Series[1]
Formula=SERIES(,'1914傾斜'!$CN$26:$DO$26,'1914傾斜'!$CN$13:$DO$13,1)
Param(0) =
Param(1) = '1914傾斜'!$CN$26:$DO$26
Param(2) = '1914傾斜'!$CN$13:$DO$13
Param(3) = 1
[Formula]
=SERIES(,'1914傾斜'!$CN$26:$DO$26,'1914傾斜'!$CN$13:$DO$13,1)
=SERIES(,,,1)
--------------------------------
cat_junkoさん
おはようございます。
情報ありがとうございました。おかげさまで原因が特定できました。
シート名がシングルクォート「'」で囲まれていると、コードとして正しく処理できない状態でした。手元の環境(2010)のみで見ていると、シート名の途中に「'」が入らない場合は「'」で囲まれませんでした。(シート名に「'」が使える事も知りませんでした…)
甘かったですね。。
「'」で囲まれている場合の対策を、これから準備します。
動作確認を含めても、そんなに時間は掛からないと思いますので
少しお時間ください。
想定よりも時間を掛けてしまいました。。
本文中のコードを修正していますので、こちらでご確認頂ければと思います。
よほど引っかかる事は無いと考えていますが、
「VBScript.RegExp」を利用するようになってしまった関係で、動作環境がIE5以上がインストールされた環境になりました。簡単に検索した結果だとWindows 98SEの時点でIE5になっているようです。
大丈夫ですよね。。
sgr-2さん
お疲れ様です。
シート名、気になったので変更してみました。
現在は、１~１１の連番です。
頭に、例えば「シート」と追記して「シート１」としたら「'」が
=SERIES('1'!$EL$15,'1'!$EM$27:$FI$27,'1'!$EM$15:$FI$15,7)
↓
=SERIES(シート1!$EL$15,シート1!$EM$27:$FI$27,シート1!$EM$15:$FI$15,7)
のように、「’」が消えました！
cat_junkoさん
シート名のご確認を頂きありがとうございます。
はっきりと理解している訳ではないのですが、先頭の文字が数字の場合に「'」で囲まれるのかもしれませんね。
確認したレベルではシート名に「'」や「!」が含まれていても「'」で囲まれる事あたりです。いずれにしても、今の修正済みのコードであれば「'」の有無に関わらず正しくシート名を取り出せるのではないかと思っています。
sgr-2さん
お疲れ様です。
修正コードでの動作確認ができました！
ほんとにほんとに嬉しすぎです。
何とお礼を言っていいのか分かりませんが本当にありがとうございました！
（修正前のコードで、試しにシート名を変更して実行したら動きました(^^;）
シート名が、数値のみだったから動かなかったんですね…><
cat_junkoさん
期待するデータ範囲に修正されるようになりましたか
良かったです!
シート名が「'」で囲まれる事がある。は私の詰めが甘かったです…
シート名を数字にするのは、結構ある事だと思いますし。
すいません、一点コメントし忘れていましたが
お昼前に修正したコードに対して、一箇所だけ再修正しています。
# 再修正の内容に直さなくても動作には問題ないです(結果は変わりません)
[下から10行目あたり]
(修正前) result = Mid(strInput, 2, Len(strInput) - Len(symbol) * 2)
(修正後) result = Mid(strInput, Len(symbol) + 1, Len(strInput) - Len(symbol) * 2)
Midを使って文字列を切り出す時に、ちゃんとsymbolの長さを数えます。2を書くのは、決め打ちになってしまっててコードとして良くないですね。
sgr-2さん
修正情報ありがとうございます！
修正しました！
このマクロのおかげで結構なファイルを処理するのも休み休みやっていたのが一瞬で終わるようになりました！
グラフの修正とフォルダ内ループ、シート間処理等々これらでかなり業務が楽になりました！
また、分からないことが発生したら質問しますので宜しくお願いいたします。
わざわざ ありがとうございます。
このようなフィードバックを頂けるのは嬉しいです。
効果が分かりやすいのは良いですね。
はい。分からない等 お力になれる事があれば
あなたの回答
tips
プレビュー
