エクセルの複数のセルの値からシート名を自動変更する

質問

エクセルのシート名を複数のセルから自動で変更する場合のマクロを教えてください。

Ｅ６に「平成」、Ｇ６に「年」、Ｉ６に「月」、Ｋ６に「日」と入力されている状態で、
間のＦ６、Ｈ６、Ｊ６が空欄となっており、それぞれに年と月と日を入力するような状態となっています。
このＦ６、Ｈ６、Ｊ６に入力した年月日情報をシート名にするようなマクロは可能でしょうか？
「２８．２．６」のように。もしくは「２８０２０６」のように６桁で。
また、Ｆ６、Ｈ６、Ｊ６の３つとものセルに値を入力した場合に、シート名が変更され、
その後に、それかのセルの情報を変更した場合は、その情報に変更されるようになればありがたいです。
下記のＱ＆Ａが近いのですが、複数セルの情報からシート名を変更する方法が分かりません。
http://okwave.jp/qa/q2025849.html

よろしくお願いします。

回答No.5

kagakusuki

回答No.2、4です。

　後から考えてみましたところ、

>Ｅ６に「平成」、Ｇ６に「年」、Ｉ６に「月」、Ｋ６に「日」と入力されている状態で

という条件がある場合は、For～To～Nextを使うよりも、For Each～In～Nextを使った方が処理を簡単に済ませる事が出来る事に気づきました。

　それから、ここまでの各回答にある方法では、もしも既存の他のシートの中に「これから設定しようとするシート名」と同名のシートが存在していた場合にはマクロがエラーとなってしまうという問題があります。
　例えば、「H28.2.6」というシート名の別シートが既に存在しているにもかかわらず、F6に28、H6に2、J6に6を入力する事で、マクロを設定したシートのシート名を「H28.2.6」に変更しようとしましても、同じExcelBook内に同名のシートを複数設定する事は出来ませんから、エラーとなってしまう事になります。

　そこで下記のVBAのマクロでは、もしこれから設定しようとするシート名と同名のシートが他のシートとして既に存在している場合には、例えば「H28.2.6 (2)」などの様に小括弧付きの数字を末尾に付け加えた形式のシート名とする事で、新たに設定しようとするシート名が、既存の他のシートと同名になる事を回避する様にしております。

Private Sub Worksheet_Change(ByVal Target As Range)

Const myAddress As String = "E6:K6"
Dim myDate As String, c As Range, n As Integer, mySheetName As String

If Intersect(Target, Range(myAddress)) Is Nothing Then Exit Sub
For Each c In Range(myAddress)
myDate = myDate & c.Value
If c.Value = "" Then myDate = "×"
Next c
If IsDate(myDate) Then
myDate = Format(myDate, "ge.m.d")
n = 1: mySheetName = myDate
Do Until _
IsError(Evaluate("ROW('" & mySheetName & "'!A1)")) _
Or Me.Name = mySheetName
n = n + 1
mySheetName = myDate & " (" & n & ")"
Loop
Me.Name = mySheetName
Else
MsgBox "日付が設定されておりません。" & vbCrLf _
& "セル範囲 " & myAddress _
& " の各セルに日付として使用可能な値を入力して下さい。" _
, vbExclamation, "無効な設定"
End If

End Sub

回答No.4

kagakusuki

済みません、回答No.2のVBAの構文中において、途中経過の動作確認のために仮に入れていた「本来の機能としては必要のない1行」である

MsgBox myDate

が消し忘れにより残ったままとなっておりました。
　ですから御質問のVBAのマクロは正しくは以下の様なものとなります。

Private Sub Worksheet_Change(ByVal Target As Range)
Const myAddress As String = "E6,F6,H6,J6"
Dim myDate As String, i As Long

If Intersect(Target, Range(myAddress)) Is Nothing Then Exit Sub
For i = 0 To UBound(Split(myAddress, ","))
myDate = myDate & "-" & Range(Split(myAddress, ",")(i))
Next i
myDate = Mid(myDate, 2)
If IsDate(myDate) Then
Me.Name = Format(myDate, "ge.m.d")
Else
MsgBox "日付が設定されておりません。" & vbCrLf _
& "セル範囲 " & myAddress _
& " の各セルに日付として使用可能な値を入力して下さい。" _
, vbExclamation, "無効な設定"
End If

End Sub

回答No.3

ushi2015

こんにちは、No1です。
済みません和暦でしたね。
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
　　Dim d As String
　　If Target.Address = "$F$6" _
　　　　Or Target.Address = "$H$6" _
　　　　　　Or Target.Address = "$J$6" Then
　　　　d = Range("E6") & "/" & Range("F6") & "/" & Range("H6") & "/" & Range("J6")
　　　　If IsDate(d) Then
　　　　　　Sh.Name = Format(d, "gemmdd")
　　　　End If
　　End If
End Sub

回答No.2

kagakusuki

>「２８．２．６」のように。もしくは「２８０２０６」のように６桁で。

との事ですが、天皇陛下の生前退位の問題から、あと何年もせずに元号が平成ではなくなるおそれがあり、新たに元号が制定されますと年が1にリセットされてしまいますので、単に「28」などから始まる様なシート名にしてしまいますと、平成の28年なのか、それとも近い将来において新たに制定される元号の28年なのか判別する事が出来なくなってしまいます。
　ですから、

>「２８．２．６」のように。もしくは「２８０２０６」のように６桁で。

ではなく、例えば「H28.2.6」や「平成28.2.6」、「h280206」などの様に、頭に「元号を示す文字列」を付けたシート名にされた方が宜しいかと思います。
　あとそれから、F6,H6,J6の内のいずれかのセルが未入力となっている場合や、「あ」や「A」、「0」、「-1」、「32」等々の「日付として使う事の出来ない値」が入力された場合には、シート名を変更しない様なマクロにしておく必要もあるかと思います。
　その様なマクロとするには、以下のVBAの構文をMicrosoft Visual Basic for Applicationの(標準モジュールではなく)シートモジュールに書き込んで下さい。

Private Sub Worksheet_Change(ByVal Target As Range)
Const myAddress As String = "E6,F6,H6,J6"
Dim myDate As String, i As Long

If Intersect(Target, Range(myAddress)) Is Nothing Then Exit Sub
For i = 0 To UBound(Split(myAddress, ","))
myDate = myDate & "-" & Range(Split(myAddress, ",")(i))
Next i
myDate = Mid(myDate, 2)
MsgBox myDate
If IsDate(myDate) Then
Me.Name = Format(myDate, "ge.m.d")
Else
MsgBox "日付が設定されておりません。" & vbCrLf _
& "セル範囲 " & myAddress _
& " の各セルに日付として使用可能な値を入力して下さい。" _
, vbExclamation, "無効な設定"
End If

End Sub

回答No.1

ushi2015

こんにちは
リンク先の方法で複数セルの値を使用するように変更するだけです。
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
　　Dim d As String
　　If Target.Address = "$F$6" _
　　　　Or Target.Address = "$H$6" _
　　　　　　Or Target.Address = "$J$6" Then
　　　　d = Range("F6") & "/" & Range("H6") & "/" & Range("J6")
　　　　If IsDate(d) Then
　　　　　　Sh.Name = Format(d, "yyyymmdd")
　　　　End If
　　End If
End Sub