2012年9月29日土曜日

○第166回目 シート名一括変更

 シート名を一括変更しようとするマクロです。
 シート名変換表を作って、それをもとに一気に変更しようというものです。
 既存のシート名の取得は、すでに作ってあるマクロで行います。それで変更前のシート名一覧を取得(シートに出力)しておきます。(『○第35回目 エクセルのファイルを分析する』参照)

 シート名変換表といってもいろいろなイメージがあると思いますが、ここでは二つのパターンを考えて見ます。
 1.シート番号、空セル、変更後のシート名 の3列で指定
 2.変更前のシート名 変更後のシート名 の2列で指定
 1.と2.の違いは、指定した列の数が3列か2列かで判定します。
 また、いつも一覧表のすべてを変更するということもないと思われますので、変更後のシート名がないものは、変更しないものとします(変更しないものを削除して詰めた形の変換表でもかもいません)。
 
 
    手順です。
 1.変換表の場所を取得する
 2.全シート名を取得する
 3.シート名で指定するものは、シート名を比べながら、変更すべきシートの番号を取得します。シート番号で指定するものは、その番号を使います。
 4.シート名を変更します。

 ポイントとは、次のとおりとなります。
'シート名の取得
  cc = Sheets.Count 'ブックにおけるシートの枚数
  If cc > 100 Then cc = 100 'とりあえず100シートを限度としています。
  For i = 1 To cc  'ワークシートの数だけ繰り返す
   ww(i) = Sheets(i).Name '取得したシート名を取得する
  Next i

 '変更すべきシート番号の取得とシート名の変更
 For i = 0 to gyo_cnt - 1
  If Cells(gyo1 + i, retu1 + retu_cnt - 1) <> "" Then '変更後が空セルの場合は処理しない
   If retu_cnt = 2 Then '変更前のシート名に基づき変更する場合
'変更元のシート番号の取得
    For ii = 1 to cc
     If Cells(gyo1 + i, retu1) = ww(ii) Then Exit For 'シート名と同じ番号を取得する
    Next ii
    sheet_no = ii
   Else 'シート番号に基づき変更する場合
    sheet_no = Cells(gyo1 + i, retu1)
   End If
   If sheet_no <= cc Then
'シート名の変更
    Sheets(sheet_no).Name = Cells(gyo1 + i, retu1 + retu_cnt - 1)
   End If
  End If
 Next

 1個とか2個の修正の場合は、通常操作のほうがいいでしょうね。
 
 
 
 

3 件のコメント:

Unknown さんのコメント...

VBAコードを書かなくても以下の記事により一括変更できます。
http://superdbtool.blog.jp/archives/951643.html

Unknown さんのコメント...
このコメントは投稿者によって削除されました。
Unknown さんのコメント...
このコメントは投稿者によって削除されました。