VBA：シートの追加とセルからの名前変更

Question

いつもお世話になっています。
ExcelのVBAで実装可能かと思うのですが、ご教授願いたく思います。

今回、大量のシートの追加（最後尾）とその追加したシートの名前を
変更するVBAを制作したいと思ったのですが

シートの追加とシートの名前変更（ソースの直接記入）までは、
なんとか出来ましたが
名前を、とある範囲のセルにある文字列に変更するという事がしたいです。

例えばE1:E5までの範囲にある文字列
「あ」
「い」
「う」
「う」
「う」
とあったら、かぶっているものは除き、「あ」「い」「う」という名前のシートを３つ追加したいという事です。

上記、もし実装可能であればご教授お願いします。
また、可能だけどokwaveの入力欄では面倒だし説明しづらい、という回答でもokです。
その場合、参考サイトなど教えて頂けると幸いです。

何卒よろしくお願いいたします。

keithin · Accepted Answer

＞にすればいいのですよね…？

えぇ，それでいいですよ。

と，正解だよと教えて貰ってからでないと，ご自分で試してみることもできないのですか？
それとも実際に「ジツは『これこれ』のマクロでやってみたらこういう具合に上手く行かなかったので教えて欲しかった」んでしたら，そういう具体的な状況をキチンと添えて新しいご相談として投稿し直してください。

＞不可視のセル

ついでに聞いちゃえで付き合わされるほうがイイ迷惑ですので，一つのご相談が解決したら新しい質問は次のご相談で投稿し直してください。こういうのは，こちらのような質問相談掲示板ではごくアタリマエのマナーですので，憶えておいてください。

sub macro2()
dim target as range
dim h as range

'見えてるセルを取得する。「全部隠れていた」場合も考える。
on error resume next
set target = worksheets("リストのシート").range("E2:E5").specialcells(xlcelltypevisible)
if target is nothing then exit sub

’以下同じ
for each h in target
on error goto errhandle
worksheets(h.value).select
on error goto 0
next
exit sub

errhandle:
’少し検査を厳しくしてみた例
if h <> "" then
worksheets("ひながたシート").copy after:=worksheets(worksheets.count)
activesheet.name = h.value
end if
resume
end sub

tom04 · Answer

No.2です。
別質問で
＞E1～E3000などの広範囲のセル範囲の場合も
＞可能でしょうか・・・？

に関しては、前回のコード内の
＞For i = 1 To 5
の行を変更すれば可能です。
例えば
＞For i = 1 To 3000
または
＞For i = 1 To ws.Cells(Rows.Count,5).End(xlUp).Row
といった感じで！
※　ただし、上限Sheet数はメモリーに依存するみたいなので、あまりにSheet数が多すぎるとエラーになったり、PCが固まったりすると思います。

次に
＞もし、追加ではなく、あるシートをコピーして追加の場合・・・
に関しては

Sub test2()
    Worksheets("Sheet名").Cells.Copy
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Paste
End Sub

とした方が良いと思います。

最後に
＞用意されたデータ範囲が非表示になってた場合
とは最初のE1以降のセルが非表示になっていた場合、非表示セルは含まない！と解釈すれば良いのですかね？

もしそうであれば前回のコード内の
＞ If WorksheetFunction.CountIf(Range(ws.Cells(1, 5), ws.Cells(i, 5)), ws.Cells(i, 5)) = 1 Then
部分を
＞If WorksheetFunction.CountIf(Range(ws.Cells(1, 5), ws.Cells(i, 5)), ws.Cells(i, 5)) = 1 _
        And ws.Rows(i).Hidden = False Then

のように変更してみてください。

この程度でよろしいでしょうか？m(_ _)m

imogasi · Answer

繰り返しを「あいううう」の列のセルを主体に考えれば仕舞いで、質問になるのはなぜ。
この列をソートしておいて、上から順次見ていって、直前上行と同じ値なら、処理せず次の行に行く。
違う場合はそのセルの値でシートを追加
ーー
Sheet1のA列（シート名群）でソート済みとする。
Sub test01()
Dim sh1
Set sh1 = Worksheets("Sheet1")
d = sh1.Range("A65536").End(xlUp).Row
m = ""
For i = 2 To d
If sh1.Cells(i, "A") = m Then '上と同じ文字列なら
Else
Worksheets.Add(After:=Worksheets(Sheets.Count)).Name = sh1.Cells(i, "A")  'こういう書き方が出来た
m = sh1.Cells(i, "A")
End If
Next i
End Sub
ーー
A2:A６
aa
bb
cc
cc
dd
で、aa、ｂｂ、ｃｃ、ｄｄのシートが加わった。
ーー
シート名をソートすることがダメな場合は、現在行までの行で、同じ文字列のカウントをして２以上ならダブリとして
処理を飛ばすロジックにするとか。

tom04 · Answer

こんばんは！

当然のことながら同じBook内に同名のSheetは追加できませんので、E1～E5セルには現在あるSheet名以外の文字列だとします。

↓のコードを標準モジュールにコピー＆ペーストしてマクロを実行してみてください。
尚、Sheet1のE1～E5セルに入っているとしての一例です。

Sub test()
    Dim i As Long
    Dim ws As Worksheet
    Set ws = Worksheets("sheet1")
    For i = 1 To 5
    If WorksheetFunction.CountIf(Range(ws.Cells(1, 5), ws.Cells(i, 5)), ws.Cells(i, 5)) = 1 Then
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = ws.Cells(i, 5)
    End If
    Next i
End Sub

こんな感じではどうでしょうか？m(_ _)m

keithin · Answer

ふつーに「やるべきこと」を考えてみると
０．用意されたデータ範囲（「あいうううう」どこからどこまで何がある）の確認
１．かぶってない「あ」「い」「う」のリストを準備
２．準備したリストに従いシートの追加と名前の変更
という段取りで，淡々とマクロを書けばよいだけのお話です。

とってもムズカシそうないかにもマクロマクロしたマクロも書けますし，ごく簡単でシンプルな方法も，アイデア次第でいくらでもあります。

でもまぁ，ゴタクはいらないでしょうから作成例：
sub macro1()
　dim h as range
　for each h in worksheets("元のリストのシート名").range("E1:E" & worksheets("元のリストのシート名").range("E65536").end(xlup).row)

on error goto errhandle
　worksheets(h.value).select
　on error goto 0
　next
exit sub

errhandle:
　worksheets.add after:=worksheets(worksheets.count)
　activesheet.name = h.value
　resume
end sub

VBA：シートの追加とセルからの名前変更

＞にすればいいのですよね…？

No.2です。

繰り返しを「あいううう」の列のセルを主体に考えれば仕舞いで、質問になるのはなぜ。

こんばんは！

ふつーに「やるべきこと」を考えてみると

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング