スポンサーリンク
はじめに
Excelで、
- 「1日」～「31日」の名前のシートを作らないといけない
- 既に何十個ものシートを設置してるけど、それらのシート名を全部変えていかないといけない
といったように、多数のシート名を設定しないといけない場面は、きっと実務でも起こると思う。
普通はそういう場合、1個1個地道にシート名変更をやっていかないといけなくて、シート数が多いと大変だ。
シート名って、シート見出しをダブルクリックしないといけなくて手間が掛かるしね。
ショートカットキーもワンタッチのものはないし。
今回はそういうケースのために、Excelのブック中のシート名を、全て一括で変更できるマクロを紹介する。
マクロの動作イメージ
まずはマクロの動作イメージから示す。先に動画から。
たとえば下図のExcelファイルには9個のシートがあって、これらのシート名をB1～B9セルに示した通りに変更したいとする。
そのB1～B9セルの範囲を過不足なく選択してからこのマクロを起動すると、その通りに全てのシート名が変更されるっていうマクロだ。
ついでに、変更前・後のシート名がどう対応しているかっていうのを示す簡易的な一覧表も、別のExcelブックとして出力するようにしてある。
動作条件
このマクロには幾つか動作条件とか設定してあるので、それも示す。
まあ後述のソースコードを見て、読める人には分かるのだけどね。
「このシート名にしたい!」というシート名を書き並べるのは、どのシートのどのセル範囲でも良い。
先述の図の例では、「このシート名にしたい!」というシート名を「Sheet6」シートのB1～B9セルに書き並べていたけど、別にこれはどのシートでも良いのね。
適当なシートの、どこか適当な空いたセルに書いていけば良い。
「このシート名にしたい!」というシート名は、縦に連続して書かれていないといけない。
先述の例ではB1～B9セルに縦に書いてたけど、横のセル範囲については無視する。
また、Ctrlキーにより「B1,B3,B6」みたいな離れたセルを選択してたら駄目。
「このシート名にしたい!」セル範囲を選択しておくが、これはシート数より多くても少なくてもいけない。
シート数が全部で9個だったら、過不足なくちょうど9個だけ選ばないといけないわけ。
ブックが保護されている場合は、マクロは動作しない。
ブックが保護されている場合は、シート名が変更できないよう保護されているということになるから。
ブックの保護を解除するという手段もあるが、そういう処理は入れなかった。
選択範囲の中に空白セルがあった場合は、それに対応するシート名は変更しない。
左から3番目のシート名が「シート03」で、選択範囲の上から3番めが空白だったなら、左から3番目のシート名は「シート03」のままということね。
空白セルがあったら作動しないようにというのも考えたが、それはやめた。
ソースコード
それでは、今回のマクロのソースコードを示す。
このマクロは、Excelの個人用マクロブックに組み込んで使うと良いだろう。
で、1つ注意。
今回のマクロでは、シート名の重複をチェックするために、連想配列というものを使っている。
連想配列についてここでは詳説はしないが、とにかくマクロで重複チェックをするのに便利なツールだ。
これを使うに当たっては
「ツール」→「参照設定」とし「Microsoft Scripting Runtime」にチェックを入れる
という設定を、個人用マクロブックに対し先に済ませておこう。
これをしとかないと、連想配列が作動してくれない。
前置きが長くなったが、いよいよソースコード。
下記のソースコードの中で
changeSheetsNames
というやつがメインとなる実行プロセスなので、これをリボン等に組み込んで実行すれば良い。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 |
Sub changeSheetsNames() 'シート名を一括変更する Dim arr As Variant If Not fncBeforeChangeSheetsNames(arr) Then Exit Sub '事前チェックを通るか確認 Application.ScreenUpdating = False Dim mainBook As Workbook Dim var As Variant Dim i As Long Dim sheetNum As Long Set mainBook = ActiveWorkbook sheetNum = mainBook.Worksheets.Count 'シート数 var = Format(Now, "yyyymmddhhmmss") 'まず全シートの名前を、仮のシート名にしておく For i = 1 To sheetNum var = var + 1 mainBook.Worksheets(i).Name = var '現在時刻(秒)を起点とした連番 Next i 'シート名を変更していく For i = 1 To sheetNum mainBook.Worksheets(i).Name = arr(i, 2) Next i Dim newBook As Workbook Dim ws As Worksheet Set newBook = Workbooks.Add '変更前・後のシート名一覧を出力するブック Set ws = ActiveSheet '見出しを付ける ws.Cells(1, 1).Value = "元のシート名" ws.Cells(1, 2).Value = "変更後シート名" ws.Cells(2, 1).Resize(sheetNum, 2).Value = arr '変更前・後のシート名一覧を配列より代入 ws.Cells(1, 1).Resize(1, 2).EntireColumn.AutoFit '列幅自動調整 Application.ScreenUpdating = True MsgBox "終了しました。変更前・後のシート名リストを出力しましたので確認して下さい。", vbInformation End Sub Function fncBeforeChangeSheetsNames(arr As Variant) As Boolean '「changeSheetsNames」の実行前チェック Dim newNameArr As Variant Dim dic As New Dictionary Dim mainBook As Workbook Dim rng As Range Dim sheetNum As Long Dim r As Long Dim rSize As Long Dim msg As String Dim str As String Set mainBook = ActiveWorkbook sheetNum = mainBook.Worksheets.Count 'シート数 Set rng = Selection rSize = rng.Rows.Count '選択された行数 'まず、新シート名のセル範囲指定が正しいかチェック Select Case True Case mainBook.ProtectStructure 'ブックが保護されているとシート名を変更できない msg = "ブックが保護されているため、中止します。" Case rSize ＜＞ sheetNum msg = "シート数と同じ" ＆ sheetNum ＆ "行を選択した場合のみ処理実行するため、今回は中止します。" Case rng.Areas.Count ＞ 1 '離れたセル範囲が選択されている場合 msg = "連続したセル範囲を選択して下さい。" End Select If msg ＜＞ "" Then '上記のチェックでエラーに該当していれば MsgBox msg, vbExclamation, "処理中断" Exit Function End If newNameArr = rng.Resize(rSize, 1).Value '変更後のシート名(加工前)を格納 ReDim arr(1 To sheetNum, 1 To 2) '変更後のシート名について、規則に沿っているか確認していく。 For r = 1 To sheetNum '元のシート名 arr(r, 1) = mainBook.Worksheets(r).Name '元のシート名を保存しておく str = Trim(newNameArr(r, 1)) '左右の空白削除 str = fncSheetNameModify(str) 'シート名に使えない文字を削除 Select Case True Case str = "" str = arr(r, 1) '新しいシート名が入力されていない場合、元のシート名のままにする Case str = "履歴" msg = "シート名：" ＆ str ＆ vbCrLf ＆ "「履歴」は、予約後のため使えません。" Case Len(str) ＞ 31 'シート名は31文字まで msg = "シート名：" ＆ str ＆ vbCrLf ＆ "は、31文字を超えているため処理中断します。" End Select If dic.Exists(str) Then '連想配列で重複チェック msg = "シート名：" ＆ str ＆ vbCrLf ＆ "が、重複しているため処理中断します。" End If If msg ＜＞ "" Then MsgBox msg, vbExclamation, "処理中断" Exit Function End If dic.Add Key:=str, Item:=r '連想配列にシート名を格納→重複チェック arr(r, 2) = str '変更後のシート名(加工後)を格納 Next r Set dic = Nothing msg = "シート名を一括変更しますか?" If MsgBox(msg, vbQuestion + vbOKCancel, "確認") = vbOK Then fncBeforeChangeSheetsNames = True '最後までOKなら実行フラグをセット End Function Function fncDeleteStrings(buf As String, ParamArray arrDeleteStr()) As String '文字列から指定文字を削除する Dim var As Variant fncDeleteStrings = buf For Each var In arrDeleteStr '配列に指定された文字を削除していく fncDeleteStrings = Replace(fncDeleteStrings, var, "") Next var End Function Function fncSheetNameModify(buf As String) As String 'シート名から使えない文字を削除する fncSheetNameModify = fncDeleteStrings$(buf, ":", "\", "?", "[","]", "/", "*") fncSheetNameModify = Left$(fncSheetNameModify, 31) 'シート名は31文字まで End Function |
ソースコード中の
fncDeleteStrings
fncSheetNameModify
というやつで、シート名に使えない文字を削除するプロセスを組み込んでいる。
その他、シート名の付け方の規則だとかについて、別に解説ページを書いているので、そちらでどうぞ。
もう既にだいぶ記事がグダグダ長くなったので、ソースコードの解説とかは書きません。
もしTwitterで当記事のこと書いてリクエストでもしてくれたら、そのときは書きますけどね。
スポンサーリンク
