EXCELのシート名自動入力

質問

EXCELでシート名にセルA1の値を自動入力したいので、
下記のマクロを使いましたが、いちいちマクロを実行しないと自動入力できません。
Public Sub SheetName()
ActiveSheet.Name = Range("A1").Value
End Sub
これを、マクロを実行しなくても、セルA1の値が変わった時点で
自動的にシート名も変わるようにできないでしょうか？

回答No.7

kagakusuki

回答No.6の画像に一部間違いが御座いましたので、画像を貼り直させて頂きます。

　尚、下記の添付画像は、各シートのシート名が最初、

別シート
Sheet2
Sheet3
Sheet4
Sheet5
Sheet6
Sheet7
Sheet8
Sheet9
Sheet10
Sheet11
Sheet12

となっている状態になっていたところに、回答No.6のマクロによる処理を行ったものです。

回答No.6

kagakusuki

>別シートのB1を手入力した際に、該当シートのシート名を自動入力させたいというのが本音なのです。

>ならば、 Address = "$A$1"でなくAddress = "別シート!$B$1"のような指定と考えてしまいますが、シート毎にA1の参照元が別シートのB1、B2、B3、B4と変わっていくので、参照先のA1で統一したいのです。

　それでしたら、各シートのA1セルへのシート名の反映は止めて次の様にされては如何でしょうか？

　まず、下記の添付画像の上側の画像の様に、別シートのA列には「シート名を変更する予定のシートの現在のシート名」を入力しておき、B列は変更後のシート名の入力欄、C列は「シート名を正しく変更する事が出来たかどうかの結果」を表示するための欄として使用します。
　その場合、下記のVBAのマクロを別シートのシートモジュール上に入力してから、B列に変更後のシート名を入力しますと、添付画像の下側の画像の様に、C列に「マクロによる処理を行った結果」が表示されるとともに、A列の値が新しいシート名に合わせて書き換えられます。
　尚、処理の都合により、別シートの1行目は項目欄として使用しますので、シート名は入力しない様にして下さい。

Private Sub Worksheet_Change(ByVal Target As Range)

Const ItemRow = 1, PreNameColumn = "A", PostNameColumn = "B", ResultColumn = "C"
Dim myRange As Variant, LastRow As Long, c As Range, PreName As Variant

With ActiveSheet
LastRow = .Range(PreNameColumn & Rows.Count).End(xlUp).Row
If LastRow <= ItemRow Then Exit Sub

Set myRange = Intersect(Target, _
.Range(PostNameColumn & ItemRow + 1 & ":" & PostNameColumn & LastRow))
End With
If myRange Is Nothing Then Exit Sub

With Application
.ScreenUpdating = False
.Calculation = xlManual
End With

With ActiveSheet
For Each c In myRange
PreName = .Range(PreNameColumn & c.Row).Value
If IsError(Evaluate("ROW('" & PreName & "'!A1)")) Then
If PreName = "" And c.Value = "" Then
.Range(ResultColumn & c.Row).Value = ""
Else
.Range(ResultColumn & c.Row).Value = "該当シート無し"
End If
ElseIf c.Value = "" Then
.Range(ResultColumn & c.Row).Value = "シート名未入力"
Else
If Not IsError(Evaluate("ROW('" & c.Value & "'!A1)")) And c.Value <> PreName Then
.Range(ResultColumn & c.Row).Value = "既に使用中のため使えない名称"
Else
On Error GoTo label1
Sheets(PreName).Name = c.Value
On Error GoTo 0
.Range(PreNameColumn & c.Row).Value = c.Value
.Range(ResultColumn & c.Row).Value = "シート名変更済み"
label2:
End If
End If
Next c

GoTo labelE
label1:
.Range(ResultColumn & c.Row).Value = "シート名に使えない文字列"
GoTo label2
End With

labelE:
With Application
.CutCopyMode = False
.Calculation = xlAutomatic
.ScreenUpdating = True
End With

End Sub

この投稿のマルチメディアは削除されているためご覧いただけません。

お礼

再度のご回答有難うございます。
残念ながら添付ファイルが削除されているのと、
余りにも高度で複雑なマクロのため、理解できませんでした。
せっかく再回答いただいたのに、申し訳ございませんでした。

回答No.5

dogs_cats

別シートのシートモジュールに下記をコピー
別シートのB１~Ｂ４が変更された時に、各シートのA1の値と別シートの変更されたセルの値が一致しているシート名を変更するとすれば良いでしょう。

Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B1:B4")) Is Nothing Then Exit Sub

Dim WS As Worksheet

For Each WS In Worksheets
If WS.Range("A1").Value = Target.Value Then
WS.Name = Target.Value
Exit For
End If
Next

End Sub

添付画像が上記コードでシート名を変更した結果です。

補足

再度のご回答有難うございます。
お陰様でご回答の内容で出来ました。
が、もうひとつだけ応用できれば、というのがあります。
シート名の参照条件等は変わらないのですが、
シート名を変更する契機（きっかけ）を
「別シートのB１~Ｂ４が変更された時」でなく、
「別シートのどこかのセルが変更された時」、
要するに「別シートの内容が少しでも変更になった時」に
変えられますでしょうか？

何度も追加リクエストで申し訳ございません。

回答No.4

kagakusuki

A1セルに入力された値がシート名には使う事が出来ない文字列である場合も考えられますから、その様な場合にもエラーとならない様にするための工夫が必要です。
　又、シート名を入力するセルをシートの中で左上の隅に位置するA1セルとしている場合であれば兎も角、もしA1セル以外のセルを、シート名を入力するセルとして使用する場合には次の様な問題が発生します。
　例えば、B2セルを「シート名を入力するセル」にしている場合で、もし、2×2よりも大きなセル範囲をコピーしてA1セルに貼り付けた場合、B2セルの値も変更されますが、Targetとは値が変更された全てのセル範囲なのですから、Targetの行番号や列番号はTargetの左上の隅のセルであるA1セルの行番号や列番号になってしまいますので、マクロの実行をTargetの行番号や列番号を基準に判定したのでは、B2セルの値が変わっているにもかかわらず、シート名が変更しない場合もあり得ます。

　ですから、次の様なマクロにされた方が良いと思います。
　尚、下記のマクロの構文は標準モジュールではなく、This Workbookモジュール上に書き込む様にして下さい。

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

Dim c As Range, temp As Variant

For Each c In Target
If c.Address = "$A$1" Then
On Error Resume Next
c.Parent.Name = c.Value
On Error GoTo 0
End If
Next c

End Sub

　尚、上記のマクロは、そのExcel book内のどのシート(新規に作成したシートも含む)であってもA1セルに値を入力すると、その値が自動的にシート名に反映されます。

　因みに、特定の1枚のシートでのみその様な処理が行われ、他のシートではA1セルに入力してもシート名は変わらない様にする場合には、上記のVBAの中の最初の行である

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

という箇所を、

Private Sub Worksheet_Change(ByVal Target As Range)

に変更した構文を、This Workbookモジュールではなく、シート名が自動的に変わる様にしたいシートのシートモジュール上に書き込んで下さい。

補足

ご回答有難うございます。
ご回答いただいたやり方でできました。
ただ、A1セルを手入力する場合は出来ましたが、
A1セルの値を別シートからの項目参照としてしまうと
出来なくなってしまいます。
実はA1セルは「=別シート!B1」という項目参照にしたくて、
別シートのB1を手入力した際に、該当シートのシート名を自動入力させたいというのが本音なのです。
ならば、 Address = "$A$1"でなくAddress = "別シート!$B$1"のような指定と考えてしまいますが、シート毎にA1の参照元が別シートのB1、B2、B3、B4と変わっていくので、参照先のA1で統一したいのです。
最初の質問文にA1が項目参照と書けば良かったのですが・・・
策はありますでしょうか？

回答No.3

dogs_cats

シートチェンジイベントのコードの記載方法は色々ありますけど、私なら下記のようにします。
ブックの全シートでａ１の値が変更された場合に、シート名を変更する場合。
下記をworkbookモジュール（ThisWorkbook)にコピー

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
ActiveSheet.Name = Range("A1").Value
End Sub

指定シートのみに実行する場合は該当シートモジュールに下記をコピー
Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
ActiveSheet.Name = Range("A1").Value
End Sub

指定シートが複数ある場合はbookモジュールで変更しないシートを指定する方法が簡単だと思います。それにはブックのシート数と変更しないシートの番号が必要です。

補足

ご回答有難うございます。
ご回答いただいたやり方でできました。
ただ、A1セルを手入力する場合は出来ましたが、
A1セルの値を別シートからの項目参照としてしまうと
出来なくなってしまいます。
実はA1セルは「=別シート!B1」という項目参照にしたくて、
別シートのB1を手入力した際に、該当シートのシート名を自動入力させたいというのが本音なのです。
ならば、 Range("A1")でなく Range("別シート!B1")と考えてしまいますが、シート毎にA1の参照元が別シートのB1、B2、B3、B4と変わっていくので、参照先のA1で統一したいのです。
最初の質問文にA1が項目参照と書けば良かったのですが・・・
策はありますでしょうか？

回答No.2

neKo_quatre

Alt+F11でVBEを表示。
左側、プロジェクトエクスプローラのウィンドウで対象のシートを右クリック-[コードの表示]

Private Sub Worksheet_Change(ByVal Target As Range)
　Call SheetName()
End Sub

を貼り付け。

では。

> これを、マクロを実行しなくても、セルA1の値が変わった時点で

マクロを実行しないわけでなくて、シートの内容が変わったら常にマクロを実行するようにしてるわけですが。

回答No.1

m_and_dmp

イベントプロシージャを使うとできます。
イベントプロシージャの作り方はつぎ↓、
http://excelvba.pc-users.net/fol3/3_6.html

コードの例：
--------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
RN = Target.Row
CN = Target.Column
If RN <> 1 Then GoTo EP
If CN <> 1 Then GoTo EP
ActiveSheet.Name = Range("A1").Value
EP:
End Sub
-------------------------------------------------------------------------------------------------------
試していませんが、これで動くと思います。

「A1の値が変化した時実行、A1以外の値が変化しても実行しない」ようにするため、つぎのコードを入れました。もっとスマートな方法があるかもしれませんので工夫してください。
RN = Target.Row
CN = Target.Column
If RN <> 1 Then GoTo EP
If CN <> 1 Then GoTo EP