[[20110916141710]]　『シート名の一括変更と並び替え』（おしろ）　ページの最後に飛ぶ

『シート名の一括変更と並び替え』（おしろ）

 いつもお世話になっております。
 シート１、一覧表となっています。
 一覧表の・・・ 
 ①
 Ｉ列に、番号が001～060まであり、
 それぞれ、シート名001～060へハイパーリンクが
 設定されてあります。

 例えば、Ｉ列、007を行ごと削除した場合、
 008～060まで繰り上がって、お尻は059となります。

 それにあわせて、リンク先のシート、007は削除、
 シート名も繰り上げて一括で名前を変更させたいのです。

 ②また、

 Ｊ列に種別Ａ～Ｃがあり、ＡＢＣ順に並べ替えた後、
 Ｉ列の001～060は全てバラバラになります。

 その時、頭から項番を付け直し、001～060にした場合、
 ハイパーリンクを付け直したいのですが
 一括でリンクを貼り直す方法はありますか？

 貼り直した後、シートの順番を並べ替えるマクロは
 こちらから参照しました。

 （ちなみにこちら）
 Sub シートの並べ替え()
 Worksheets.Add Before:=Sheets(1)
 Sheets(1).Name = "NEW"

 Dim N As Integer, SN As Variant, I As Integer, J As Integer
   On Error Resume Next
   N = Worksheets.Count
        For I = 2 To N
              Worksheets("NEW").Select
              Range("A1").Select
              Selection.Offset(I).Value = ActiveWorkbook.Worksheets(I).Name
        Next I

   Range("A3:A65536").Select
   Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,   
 SortMethod _
        :=xlPinYin, DataOption1:=xlSortNormal

   For J = 1 To N
       Worksheets(1).Select
       Range("A2").Select
       SN = Selection.Offset(J).Value
       Sheets(SN).Move After:=Sheets(J)
   Next J

 Worksheets("NEW").Activate
 Application.DisplayAlerts = False
 ActiveWindow.SelectedSheets.Delete
 Application.DisplayAlerts = True

 End Sub

 以上の２点、御教授ください。

 宜しくお願いします。

 とりあえず①に対して質問。

 >例えば、Ｉ列、007を行ごと削除した場合、
 >008～060まで繰り上がって、お尻は059となります。

 ほんと？
 008～060が繰り上がるのはそのとおりだけど、おしりは060でしょ？単に007へのリンクの行がなくなっただけじゃない？

 やりたいことは、その時に、008以降のシート名を変更して、かつ8行目以降のリンク先のシート名も変更後のシート名にしたい。
こういうことかな？

 で、シート名を「繰り上げる」ということだけど、たとえばシート名が「東京123」なら「東京122」にするということ？
つまり、シート名の末尾には「連番」の「数字」がついているので、それをアップするということなのかな？

 追記）②についても。

 ①と同様、「シート名」がどうなっているのか、その説明がないので想像をたくましくすると
話を簡単にするために３行で３つのシートにリンクがはられているとする。
そのシート名は左から順番に「りんご」「みかん」「ばなな」
で、I1は「りんご」へ、I2は「みかん」へ、I3は「ばなな」へのリンク。
で、リンクを貼ってあるシートを並びかえて、かりに、うえから「ばなな」「りんご」「みかん」になったとする。
このとき、シート名とシートの順番は、そのままで、I1,I2,I3のリンクだけをもとの「りんご」、「みかん」、「ばなな」の順番に置き直したい。

 こういうこと？

 さらに追記）タイトルのなかにある　「並び替え」ってシートそのものの順番をならびかえたいように
読めるけど、そういう要件は質問には記載されていないよね。
つまり、シートそのものの順番を並び替えるということは質問していないということだね。
アップしたコードでそれをやってるよというぐらいに受け取ればいいね。

 もう一度、質問文をよ～く読んでみた。
シート名 001～060 は、考え方の例として書いてあると思ったけど、ほんとうに001～060 というシート名なのかな？
で、ブック内の「一覧表」というシート名のもの以外は、左から001,002,003・・・・

 一覧表 I列の記載ルールは、うえから順番に001,002,003・・・・へのハイパーリンク。
かつ、一覧表以外のシートの順番はこのI列に埋め込まれたハイパーリンクの順番通りになっている、というかそのような状態を維持したい。
そのため
・一覧表側で行削除されたら、シートも削除し、シートをあらためて001,002,003・・・という名前にした上で、ハイパーリンクも001,002,003。
・一覧表で並び替えが行われたとしたら、シート名と、その順番ははそのままで、I1からのリンクを001,002,003・・・・に変更。
こういうことをやりたいということなのかな？

 (ぶらっと)

 「行が削除されたら・・・」という要件、わかりやすいんだけど、エクセルのＶＢＡでは、行削除イベントがないので
行が削除されたかどうかを判断するのは、結構シビレル話になる。
「ＶＢＡ　行削除イベント」あたりで検索すると、いろいろおもしろい情報があるね。

 なので、ちょっとした小技をつかったり、あるいは大技をつかったり、あるいは操作上で、操作者の助けを借りたり。
以下の例はシート数とハイパーリンクの数の比較で処理の要否を判定。

 さらに、質問の回答をもらってないので想像して書いている。
もし、そちらの要件にあわなければ無視してね。明日から１週間ほど留守にするのでフォローはできないかも。

 ・行削除されると自動的にシートとリンクの整合性を保つ「シートとリンクの一致」が実行される。
 ・並び替えの後は「Linkふり直し」を実行。

 なお、標準モジュールの３つのプロシジャは、いずれも、単独で必要なつど実行可能。

 (一覧表シートのシートモジュールに）

 Private Sub Worksheet_Change(ByVal Target As Range)
    Call シートとリンクの一致
 End Sub

 (以下は標準モジュールに）

 Sub シートとリンクの一致()
 'リンクのあるシート以外は削除
 '続けて　シート名再設定、Linkふり直し　を自動実行
    Dim c As Range
    Dim s As String
    Dim sh As Worksheet
    Dim sa As String
    Dim hl As Hyperlink

    With Sheets("一覧表")
        'I列にハイパーリンクがあり、その数が一覧表を除いたシート数と異なる場合にのみ処理
        If .Columns("I").Hyperlinks.Count > 0 And Worksheets.Count - 1 <> .Columns("I").Hyperlinks.Count Then
            For Each hl In .Columns("I").Hyperlinks
                s = s & vbTab & Replace(Split(hl.SubAddress, "!")(0), "'", "")
            Next
            s = s & vbTab
        End If
        For Each sh In Worksheets
            If sh.Name <> .Name Then
                Application.DisplayAlerts = False
                If InStr(s, vbTab & sh.Name & vbTab) = 0 Then sh.Delete
                Application.DisplayAlerts = True
            End If
        Next

        Call シート名再設定
        Call Linkふり直し

    End With
 End Sub

 Sub シート名再設定()
 '一覧表以外のシート名が左から順に昇順になっているという前提。
 'そうでなければエラーになる可能性がある。
 'エラー回避策もとれるけど、以下のコードは、それを割愛。
    Dim n As Long
    Dim sh As Worksheet
    With Sheets("一覧表")
        For Each sh In Worksheets
            If sh.Name <> .Name Then
                n = n + 1
                sh.Name = Format(n, "000")
            End If
        Next
    End With

 End Sub

 Sub Linkふり直し()
 '並び替え後のリンクの順序をシートの順序にあわせる
    Dim c As Range
    Dim sh As Worksheet
    Application.EnableEvents = False
    With Sheets("一覧表")
        .Columns("I").Clear
        Set c = .Range("I1")
        For Each sh In Worksheets
            If sh.Name <> .Name Then
                .Hyperlinks.Add Anchor:=c, Address:="", SubAddress:=sh.Name & "!A1", TextToDisplay:=sh.Name
                Set c = c.Offset(1)
            End If
        Next
    End With
    Set c = Nothing
    Application.EnableEvents = True
 End Sub

 (ぶらっと)

★ぶらっと　様

 遅くなりまして大変失礼致しました！
 回答、ほんとうに001～060というシート名です。
 で、一覧表のシートに同じ001～060がＩ列にいて
 左から001.002.003・・・へ、ハイパーリンクです。

 取り急ぎお返事いたしましたが
 すぐに 行削除　イベントで調べてみます。
 また、お休み前に考慮していただき
 大変恐縮です。
 すぐにトライしてレスいたします。

 (おしろ）

コメント返信：

[ 一覧(最新更新順) ]

[[20110916141710]] 『シート名の一括変更と並び替え』（おしろ） ページの最後に飛ぶ

[[20110916141710]]　『シート名の一括変更と並び替え』（おしろ）　ページの最後に飛ぶ