エクセル 特定のセルの値をシート名にする マクロ

質問

お知恵をお貸しください。
現在、月計表なるものを作っています。
シートは12あります。
シート名は「1月、2月、3月、、、12月」としています。

1月シートの「月度セル（D1）」をリスト選択としており1～12までを選択するようにしています。
他のシートの「月度セル」は直前のシートの「月度セル」の値を参照し、「直前のシートの月度値が12」であれば「1（翌年になるので）」を、12以外であれば「直前のシートの月度に＋1」した値を自動表示するIF関数を書いています。
2月シートの月度セルの関数＞=IF('1月'!$D$1=12,1,'1月'!$D$1+1)

ここで問題となったのが、1月シートの月度を1月以外にした時に、シート名とシート内の月度がミスマッチを起こしてしまうということです。
例＞1月シートの月度を「2」とするとシート名は「1月」なのにシート内の月度項目は「2」月となる。

色々調べて以下のマクロを見つけたのですが、、、

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ERR_HANDLER
If Target.Address(False, False) = "D1" Then
ActiveSheet.Name = Range("D1").Value
End If
Exit Sub
ERR_HANDLER:
MsgBox "現在のD1セルの値はシート名にできません。"
End Sub

これをVisual Basic画面で各シート（12のシート全て）に記述してみました。
確かに、1月シートは「月度」をプルダウンで選択したと同時にシート名も月度のセル値と同じ値に変わるのですが、2月以降のシート名はそれだけ（1月シートの月度を選んだだけ）では変わりませんでした。

2月以降のシート名を変更するには、各シートの月度セルをアクティブにし、そこに記述している前途のIF関数を再計算させないと変更されませんでした。
これでは、、、再計算させるより2月以降の月度を手入力した方が早いかもしれません。
でも、それでは。。。

調べた中で「ThisWorkbook」に記述すればどのワークシートでも機能するような事が書いてあったのですが、既にお手上げ状態で。

お知恵をお貸しいただければ幸いです。
宜しくお願い致します。

回答No.4

kagakusuki · ベストアンサー

回答No.3です。

>シート名変更を分かり易くするため、試行前にシート名を「a、b、c・・・ｌ」とアルファベットにしました。
>その後ThisWorkbookにコードを記述（コピペ）し、一番左シートの「月度セル（D1）」の値を変更してみました。
>結果、シート名に変化はありませんでした。
>（アルファベットのまま。エラー表示もなし）

　それは当然です。
　単純に左から数えて1～12番目のシートのシート名やD1セルの値を書き換えてしまったのでは、1月～12月の月名のシート以外にも何か別の事に使うためのシートがあった場合、関係の無いシートも書き換えてしまう事になる恐れがあります。
　例えば別の作業を行った際に月のシートの一部を誤って削除してしまい、月のシートが11枚の状態のまま左から12枚のシートを書き換えた場合、書き換えてはいけないシートも書き換えてしまいます。
　又、何かの拍子に左から数えて13番目以降にあったシートを1～12番目に移動してしまったり、1月～12月の月名のシートの一部を、末尾等の13番目以降の位置に移動させてしまった場合も同様です。
　その様な事を避けるために、回答No.3のマクロでは「『半角数字の1～12の整数値』+漢字の『月』」という形式のシート名のシートのみを書き換える様にしております。
　その事に関しては回答No.3においても

>　尚、「Sheet1」や「13月」といった類の「1月～12月の月名ではないシート名」のシートに対しては、D1セルに値を変更しても下記のマクロは起動しませんし、下記のマクロで1月～12月のシートの書換えが行われた場合でも、その他の「Sheet1」や「13月」といった類のシートのD1セルの値やシート名等の書換えは行われませんので、1月～12月のシート以外のシートを併用する事が出来ます。
>　後、1月～12月の各月のシートのシート名に関してですが、「月」の前に記される1～12の数の部分は必ず半角数字で記述されている様にして下さい。(１月～１２月の様に全角数字で記述され居てるシートは書き換えられません)

と書いております。
　そのため、「a、b、c・・・ｌ」のアルファベット名のシートに対しては書き換えが行われません。
　ですから、お手数かも知れませんが書き換えの対象とするシートのシート名を、「『半角数字の1～12の整数値』+漢字の『月』」という形式のシート名に訂正してからお試し下さい。

　尚、12枚の月のシート同士の間でも、シートの移動によって順番が狂うかも知れず、それをそのまま左端から順番に月名が並ぶ様に書き換えてしまったのでは、ワークシートに入力されている関数の関係と、シート名に入力されている付き名との関係が狂ってしまいますので、回答No.3のマクロでは、「D1セルに入力された数値」と、「元のシート名に記されている月を表す数」の差を求めて、それを各月のシートのシート名とD1セルの値に反映させる様にしています。
　又、各月のシートのD1セルに「月に変換できない値」が入力された場合には、D1セルの値をシート名に合わせた半角文字の数値に強制的に書き換える様になっております。

お礼

kagakusuki 様

ご回答有難うございます。
また、当方の理解度の無さ、文章をよく読んでいなかったこと深くお詫び申し上げます。

仰る通りシート名を半角数字の1～12の整数値＋漢字の「月」（1月、2月、3月・・・12）と変更し、1月シートの月度を変更しました。

私が実現したかったこと、全くそのままの動作となりました。
深く深く御礼申し上げます。

回答No.5

m_and_dmp

No.2です。
最初にシート名をリセットしてやると良いと思います。

動いた例
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo ERR_HANDLER
SN1 = Sheets(1).Name
If Left(SN1, 1) Like "[0-9]" Then
SN = "Sheet"
Else: SN = 100
End If
For i = 1 To 12
Sheets(i).Name = SN & i
Next i

If Target.Address(False, False) = "D1" Then
For i = 1 To 12
Sheets(i).Name = Sheets(i).Range("D1").Value
Next i
End If
Exit Sub
ERR_HANDLER:
MsgBox "現在のD1セルの値はシート名にできません。"
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
以上のコードで動きましたが、D1に記述する値がどんな値であっても動くかどうか分かりません。バグ出しが必要と思います。

上記のうち、次の部分がシート名をリセットするコードです。
新しく設定するシート名が現在のシート名と同じだと、どんなことをしてもエラーになりますので、リセットするときは、同じ名前になる可能性が少ない名前になるようにします。
そこで、設定されているシート名が数字で始まる場合は Sheet1, Sheet2, ... に変更します。
シート名の最初の文字が数字ではない場合は、101 から始まる連番(101, 102, 103, ... )になるようにしました。
このあたりは、実情に合わせて適当に変更します。

ーーーーーーーーーーーーーーーー
SN1 = Sheets(1).Name
If Left(SN1, 1) Like "[0-9]" Then
SN = "Sheet"
Else: SN = 100
End If
For i = 1 To 12
Sheets(i).Name = SN & i
Next i
ーーーーーーーーーーーーーーーー

シート名を"D1"の値に変更する部分のコードは以前のままで良いと思いますが、コードが長くなるので、for i = 1 To ... を使って整理しました。ただし、Sheet2が別の用途に使われていると「動いた例」のコードは使えませんので、以前のコードを使ってください。

お礼

この度はご教授いただきまして誠に有難うございました。

回答No.3

kagakusuki

本来であれば、シート名とそのシート上のD1セルの値を一致させるだけという事なのですから、態々、その双方を書き換えるなどという事をせずとも、シートタブをドラッグアンドドロップするなり、[シートの移動]を使うなりする事で、シートの順番を並べ替えるだけでも似た様な結果が得られますが、おそらく御質問の件では、

=IF('1月'!$D$1=12,1,'1月'!$D$1+1)

というもの以外にも各シートに関数が設定されていて、(一番左端のシートを除いて)それぞれのシートは左隣のシートのデータを参照しているために、シートの並んでいる順番を変える訳には行かないという事なのではないかと想像します。
　もしもそういう事情なのだとした場合には、リスト選択を行う「月度セル（D1）」が存在するシートとは、シート名を書き換える度に名称が変わる１２枚のシートの内の「"その時点での"１月シート」等ではなく、一番最初に１月シートだったシート、即ち、一番左端にあるシートという事になる筈です。
　ですから、

>既にお手上げ状態

という事でしたら、無理をして

>「ThisWorkbook」に記述すればどのワークシートでも機能する

という事までしなくとも、一番左端にあるシートにChangeイベントのVBAを記述しておき、一番左端にあるシートのD1セルに新たな値が入力された時だけマクロを動作させて、全ての月のシートのシート名を書き換える様にされれば済む話ではないかと思います。

　尚、一応念のために、一番左端のシートに限定せず、どの月のシートであってもD1セルに1～12の数値か１月～12月の月名が入力されると、入力された1～12の値に合わせて全ての月のシートのシート名と、D1セルの値を書き換えるというVBAを組んでみました。(記述する場所はThisWorkbook)
　但し、D1セルの値を書き換えるという機能の関係で、1～12の数値が上書きされてしまうため、1月～12月のシートのD1セルに入力されている関数は消えてしまいます。(D1以外のセルの関数やデータは上書きされません)
　とは言え、もしD1セルに月名にはならない値が入力された場合でも、元々のシート名に合わせてD1セルの値が再度書き込まれる様になっておりますから、シート名とD1セルの値が必ず一致する様になっております。
　尚、「Sheet1」や「13月」といった類の「1月～12月の月名ではないシート名」のシートに対しては、D1セルに値を変更しても下記のマクロは起動しませんし、下記のマクロで1月～12月のシートの書換えが行われた場合でも、その他の「Sheet1」や「13月」といった類のシートのD1セルの値やシート名等の書換えは行われませんので、1月～12月のシート以外のシートを併用する事が出来ます。
　後、1月～12月の各月のシートのシート名に関してですが、「月」の前に記される1～12の数の部分は必ず半角数字で記述されている様にして下さい。(１月～１２月の様に全角数字で記述され居てるシートは書き換えられません)

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

'QNo8953220_エクセル_特定のセルの値をシート名にする_マクロ

Dim i As Byte
Dim myOK As Boolean
Dim myValue As Variant
Dim myElapsed As Integer
Dim EntryCell As String

On Error GoTo label_End
EntryCell = "D1"
If Intersect(Target, ActiveSheet.Range(EntryCell)) Is Nothing Then GoTo label_End
myOK = False
For i = 1 To 12
If ActiveSheet.Name = i & "月" Then myOK = True
Next i
If Not myOK Then GoTo label_End
myValue = Replace(ActiveSheet.Range(EntryCell).Value, "月", "")
If IsDate("1904/" & myValue & "/1") Then
myElapsed = Val(myValue) - Val(Replace(ActiveSheet.Name, "月", ""))
Else
myElapsed = 12
MsgBox "現在の" & EntryCell & "セルの値はシート名にできません。" & Chr(13) _
& "有効な値は1～12の整数値だけです。", vbExclamation, "無効な入力値"
End If
If myElapsed = 0 Then GoTo label_End
For i = 1 To 12
If Not IsError(Evaluate("ROW('" & i & "月'!A1)")) Then _
Sheets(i & "月").Name = Month(DateSerial(1905, i + myElapsed, 1)) & "月゜"
Next i
For i = 1 To 12
If Not IsError(Evaluate("ROW('" & i & "月゜'!A1)")) Then
Sheets(i & "月゜").Name = i & "月"
Sheets(i & "月").Range(EntryCell).Value = i
End If
Next i

label_End:

End Sub

補足

kagakusuki　様

ご回答有難うございます。

＞というもの以外にも各シートに関数が設定されていて、(一番左端のシートを除いて)それぞれのシートは左隣のシートのデータを参照しているために、シートの並んでいる順番を変える訳には行かないという事なのではないかと想像します。
　もしもそういう事情なのだとした場合には、リスト選択を行う「月度セル（D1）」が存在するシートとは、シート名を書き換える度に名称が変わる１２枚のシートの内の「"その時点での"１月シート」等ではなく、一番最初に１月シートだったシート、即ち、一番左端にあるシートという事になる筈です。

全くその通りでございます。
説明不足、申し訳ございません。

早速、ご教授いただきましたコードを以下の条件で試してみました。
シート名変更を分かり易くするため、試行前にシート名を「a、b、c・・・ｌ」とアルファベットにしました。
その後ThisWorkbookにコードを記述（コピペ）し、一番左シートの「月度セル（D1）」の値を変更してみました。
結果、シート名に変化はありませんでした。
（アルファベットのまま。エラー表示もなし）
申し訳ありませんが、知識不足なため、動作しない原因の検証までは至っておりません。

他の方への補足に書いたのですが、以下のコードで全てのシート名が各シートのD1の値へ変わりました。
しかし、これには「シート名が重複する場合は動作しない」という新たな課題が出てきました。
「とにかく今のシート名がどうであっても各シートのDの値に強制的に書き換える」といったことができればクリアとなるのですが。。。

他の方法も含めご教授いただけましたら幸いです。
宜しくお願い致します。

＜シート名が各シートのD値に変更されたコード＞
※変更後のシート名が既存のシート名と重複しない場合のみ動作

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo ERR_HANDLER
If Target.Address(False, False) = "D1" Then
Sheet1.Name = Sheet1.Range("D1").Value
Sheet3.Name = Sheet3.Range("D1").Value
Sheet4.Name = Sheet4.Range("D1").Value
Sheet5.Name = Sheet5.Range("D1").Value
Sheet6.Name = Sheet6.Range("D1").Value
Sheet7.Name = Sheet7.Range("D1").Value
Sheet8.Name = Sheet8.Range("D1").Value
Sheet9.Name = Sheet9.Range("D1").Value
Sheet10.Name = Sheet10.Range("D1").Value
Sheet11.Name = Sheet11.Range("D1").Value
Sheet12.Name = Sheet12.Range("D1").Value
Sheet13.Name = Sheet13.Range("D1").Value
End If
Exit Sub
ERR_HANDLER:
MsgBox "現在のD1セルの値はシート名にできません。"
End Sub
※シート移動をしている為、「Sheet2」は記述していません。

回答No.2

m_and_dmp

No.1 です。
各シートのD1 にシート名にする文字列を入力するものと思っていましたが、
貴殿のもうひとつの質問を拝見して、貴質問の意図するところが分かりました。
問題は次のコードにあるもとの思われます。
ActiveSheet.Name = Range("D1").Value
これでは、ActiveSheet 以外のシートに動作が及びません。

ためしにつぎのようにしてみたら、動くことが分かりました。
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo ERR_HANDLER
If Target.Address(False, False) = "D1" Then
Sheets(1).Name = Sheets(1).Range("D1").Value
Sheets(2).Name = Sheets(2).Range("D1").Value
Sheets(3).Name = Sheets(3).Range("D1").Value
Sheets(4).Name = Sheets(4).Range("D1").Value
End If
Exit Sub
ERR_HANDLER:
MsgBox "現在のD1セルの値はシート名にできません。"
End Sub

Sheets(1) ,Sheets(2) ... とする理由は、随時シート名が変わってしまうので"Seets1"とすると、エラーになってしまうからです。

私が試したコードは、ActiveSheet.Name = Range("D1").Value に問題があることを確かめたかったからです。あまりスマートではありませんが、目的を達することはできます。あとは工夫をしてください。

補足

ご連絡が遅くなり申し訳ございません。
また、追加のご回答誠に有難うございます。

早速お教えいただいたコードを以下の条件の基、記述してみました。
まず、シート名の重複を考えて事前に変更対象12シートの名称をそれぞれ「a、b、c・・・ｌ」としました。
それから、ThisWorkbookにコードを記述し、一番左のシート（シートa）の月度の値を「2」へ変更してみました。
※うまくいけば「a⇒2へ」、「b⇒3へ」、「c⇒4へ」、、、、「l⇒12へ」変わる。

結果は、「シートb」の名称が「3」に変わりました（b以外はアルファベットのまま変化なし）が、後のシート名には変化がありませんでした。
無知なため、どうしてそうなるのかの原因は分かりませんでしたが、自分なりにコードを以下のように変更したところ、全てのシート名が各シートの「D1」の値の名称に変わりました。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo ERR_HANDLER
If Target.Address(False, False) = "D1" Then
Sheet1.Name = Sheet1.Range("D1").Value
Sheet3.Name = Sheet3.Range("D1").Value
Sheet4.Name = Sheet4.Range("D1").Value
Sheet5.Name = Sheet5.Range("D1").Value
Sheet6.Name = Sheet6.Range("D1").Value
Sheet7.Name = Sheet7.Range("D1").Value
Sheet8.Name = Sheet8.Range("D1").Value
Sheet9.Name = Sheet9.Range("D1").Value
Sheet10.Name = Sheet10.Range("D1").Value
Sheet11.Name = Sheet11.Range("D1").Value
Sheet12.Name = Sheet12.Range("D1").Value
Sheet13.Name = Sheet13.Range("D1").Value
End If
Exit Sub
ERR_HANDLER:
MsgBox "現在のD1セルの値はシート名にできません。"
End Sub
※シート移動をしている為、「Sheet2」は記述していません。

シート名が変わった時は感動ものでした・・・が、更なる課題も出てきてしまいました。
2回目に一番左のシート（この時のシート名称は「1」）の月度の値を「2」へ変更した時、「変更できません」とのエラーが表示されました。

！！恐らくシート名の重複（既に2という名称のシートが存在するため）だと思われます。
確認のため、全てのシート名称を手動でアルファベットにして再度試みたところ、、、全て変更されました。

重複しても強制的に変更できればこの問題はクリアなのですが。
もしご存知でしたら、宜しくお願い致します。

回答No.1

m_and_dmp

各シート（12のシート全て）に記入するのではなく、ThisWorkbook に記入すのではないでしょうか？

試してみました。
ThisWorkbook が開いたら、右側のプルダウンメニューでWorkbook を選択すると、左側のプルダウンメニューでイベントを選択できるようになりますが、その中からSheetChange を選択するとつぎのようなコードが自動的に出てきます。
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

End Sub

これと貴質問のコードを比較すると、ちょっと違いがあります。
貴質問のコードの最初の行と、最後の行を除いた部分を上記の一行目とEnd Sub の間に書き込んで試してみましたところ、貴殿が意図したとおり動きました。
ByVal Sh As Object, を削除するとエラーになりました。

Excel は2003 です。
参考になりますか？

補足

m_and_dmp　様
ご回答有難うございます。
早速ご教授いただいたことを試してみました。
記述したコードは以下のものです。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

On Error GoTo ERR_HANDLER
If Target.Address(False, False) = "D1" Then
ActiveSheet.Name = Range("D1").Value
End If
Exit Sub
ERR_HANDLER:
MsgBox "現在のD1セルの値はシート名にできません。"

End Sub

その後の動作は以下のようになりました。

1）1月シートの「月度セル（D1）」でリストから「12」を選択
2）1月シートの名称が「12」へ変わりました。

しかし2月シート以降のシート名は変更されず、「2月、3月、、、12月」のままでした。
試しに2月シートをアクティブにし、当シート内の「月度セル」を選択、数式バーのIF関数をクリックし、一旦数式編集モードにした後、編集せずにエンターキーを押すと2月シートのシート名称が「2月⇒2」と変更されました。

1月シートの「月度」を変更すると、全シート名称を変更することは出来ないのでしょうか・・・。

エクセルは2007なのですが、2003とは動作が異なるのでしょうか・・・。

もし、お気づきの点がありましたら、どうぞご教授をお願い致します。