マクロ【シート名に対応した文字を挿入・置換】

質問

マクロ【シート名に対応した文字を挿入・置換】

御世話になります。

【D:\test】内に２つのエクセルファイル（Excel2003）があります。

※１つ目のファイル名は【季節別表.xls】。
中には一番左端のシート名は【起動シート】で、その横は【spring】【summer】【autumn】【winter】という名前のシートが
あり、すべてのシートにはサンプルの表がある。

※２つ目のファイル名は【データシート.xls】。
中にはシート名【2008】のみが存在。
シート内には下記のような文字を入力している。

セルB2：シート名
セルC2：季節名
セルD2：気候

セルB3：spring
セルC3：春
セルD3：暖かい

セルB4：summer
セルC4：夏
セルD4：熱い

セルB5：autumn
セルC5：秋
セルD5：涼しい

セルB6：winter
セルC6：冬
セルD6：寒い

B2・C2・D2はシートの列が何の項目であるかがわかるために入力。
B3～6は【季節別表.xls】に存在するシート名を縦に入力。

悩んでいるのは【季節別表.xls】のシート名【起動シート】内にあるマクロボタンに入れるマクロです。

理想の処理の流れですが、
【データシート.xls】のセルB3のspringというシート名が【季節別表.xls】にあればそのシートに
セルB3の右隣であるセルC3の文字列【春】を取得し、【季節別表.xls】のシート名【spring】のセルD35の文字列である
【今年の季節名は入学シーズンである。】の【季節名】と置換。
また、セルC3の右隣であるセルD3の文字列【暖かい】を取得し、
【季節別表.xls】のシート名【spring】のセルF70の文字列である【気候は気候状況。】の文字列【気候状況】と置換。

この処理が終わったら、今度は次の行を同じような処理を続け、最終的にはB列が空行になるまで続けられるマクロは
可能でしょうか？
何か簡単なサンプルコードがあれば助かります。

宜しくお願い致します。

回答No.4

imogasi

説明は丁寧に長く書いてあるが、読む側にはわかり難い。
下記に別の説明例を挙げてみる。参考にしてみて。
持論だが、説明とプログラム作成は密接に関連していると思う。
A.季節別表ブック
　　起動シート
　　Springシート
　　Summerシート
　　Autumnシート
　　Winterシート
B.データシートブック
　　2008シート
ーー
情報はデータシート（ブック）ににあり
　　その2008シートの
　　Ｂ列　　　Ｃ列　　D列
　　シート名　季節名　気候
　　spring　　春　　　暖かい
　　summer　　夏　　　熱い
　　autumn　　秋　　　涼しい
　　winter　　冬　　　寒い
（このようにエクセルの表式に書くと直観的に判りやすいよ）
＝＝＝＝＝＝＝＝＝
処理したいこと
（１）「季節別表ブック」を開く（データシートブックも開く）
（２）「季節別表ブック」の各シート名を調べる
（３）その１つのシート名が、データシートブックの２００８シート名のB列にあるか調べる。（あるはずしょうね。）
（４）２００８シートのB列でシート名が見つかった行の、C列の文字列（データ）で、季節別表のシートのD３５セルの一部の特定の文字列を置換
（５）見つかった行のD列の、文字列（データ）で、季節別表のシートのD３５セルの文字列の一部を置換
＝＝＝＝＝
コード作成の参考事項
（１）はVBAの本にもWEBにも書いてある。
（２）は下記を参考に
Sub test02()
Dim sh As Worksheet
For Each sh In Worksheets
MsgBox sh.Name
Next
End Sub
MsgBox sh.Nameのところに（３）（４）（５）の処理を入れる。
（３）は上記で得たシート名がForNextでB列の各行を等しいかIF文で聞いて、一致した行を見つける。（この際は総当り法にしておくのが無難。）
（４）（５）の置換は、置換操作をして、マクロの記録を採ってみて考えればわかる。
ーーー
（６）１つのシートしか対象にしてないVBAに慣れた者には、難しいのは、２つのブックや多数のシートを扱うので、シートやセルを指定するとき、上位のオブジェクトのブックやシート名を明確にエクセルに判るように記述しないとうまく行かない。
ーーー
上記（６）を含め、質問の書き振りからして、質問者には前途多難と思うが、１つづつやるよりほかなかろう。

回答No.3

n-jun

Sub test()
Dim wsDATA As Worksheet
Dim ws As Worksheet
Dim r As Range

'データシート.xlsの一番左のワークシート
Set wsDATA = Workbooks("データシート.xls").Worksheets(1)

With wsDATA
'データシート.xlsの一番左のワークシートのB3～B列の最終まで実行する
For Each r In .Range(.Range("B3"), .Cells(Rows.Count, 2).End(xlUp))

On Error Resume Next
'【spring】【summer】【autumn】【winter】という名前のシートをセット
Set ws = ThisWorkbook.Worksheets(r.Value)
On Error GoTo 0

'無事にシートが見つかれば、単語の置換を実行
If Not ws Is Nothing Then
ws.Range("D35").Value = Replace(ws.Range("D35").Value, "季節名", r.Offset(, 1).Value)
ws.Range("F70").Value = Replace(ws.Range("F70").Value, "気候状況", r.Offset(, 2).Value)
End If

Next
End With
End Sub

ご参考程度に。

回答No.2

n-jun

Excel(エクセル) VBA入門：セル範囲の指定方法
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_cell.html

Excel(エクセル) VBA入門：繰り返し処理(For～Next,Do～Loop)
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_for_next.html

Replace関数
http://www.officetanaka.net/excel/vba/function/Replace.htm

ブック・シートが存在するか調べる
http://www.officetanaka.net/excel/vba/tips/tips10.htm

ご参考まで。

回答No.1

n-jun

＞マクロは可能でしょうか？
提示された条件のみであれば可能だと思います。

簡単なサンプルとは、理想の処理のどの部分についてですか？

お礼

ご回答ありがとうございます。

＞簡単なサンプルとは、理想の処理のどの部分についてですか？
できれば最終的にはB列が空行になるまで続けられるところまでの処理のサンプルがほしいのですが、とりあえずは１行目の『【季節名】と置換。』までのサンプルでお願い致します。