[[20180831123952]]　『シート名をセルに反映できますか？』（事務まま）　ページの最後に飛ぶ

『シート名をセルに反映できますか？』（事務まま）

顧客別シートがずらり30個ほどあります。
シート名は各会社名。

挿入で新しいシートを追加し「顧客一覧」とします。
そこに30個の顧客別シートのタイトル名を縦に一覧表として作りたいのですが、各会社のシート名をそのままリンクさせることは可能でしょうか？

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

 シートの追加・削除などは行われるのだろうか？
（ねむねむ） 2018/08/31(金) 12:55

あります｡｡｡
（事務まま） 2018/08/31(金) 12:57

 EXCEL4.0マクロ関数というものを使用する。
 また、顧客一覧は一番左端とする。
 まず数式-定義された名前-名前の定義で
 名前：SHEET_NM（これは自分の好きで構わない）
 範囲：ブック
 参照範囲：=GET.WORKBOOK(1)&LEFT(NOW(),0)
 とする。
（ねむねむ） 2018/08/31(金) 13:17

 次に顧客一覧に
 =IFERROR(REPLACE(INDEX(SHEET_NM,ROW(A2)),1,FIND("]",INDEX(SHEET_NM,ROW(A2))),""),"")
 と入力して下へフィルコピーする。
 これでシート名の一覧が表示される。

（ねむねむ） 2018/08/31(金) 13:22

 ただし、シートを削除した際にはすぐに反映されるがシートを追加した際にはいったん保存して開きなおすか、そのシート名を変更するか
 F9キーを押して再計算をさせないと反映されない。
 また、このブックはマクロ有効形式（XLSM）で保存しないとならない。 
（ねむねむ） 2018/08/31(金) 13:24

マクロでよければ、、
(顧客一覧シートのA1が見出し、A列二行目以下にリスト作成だとして)

    Sub Macro1()
        Dim Ws As Worksheet, K As Worksheet
        Set K = ThisWorkbook.Sheets("顧客一覧")
        For Each Ws In Worksheets
            If Ws.Name <> "顧客一覧" Then
                K.Cells(K.Cells(K.Rows.Count, "A").End(xlUp).Row + 1, "A") = Ws.Name
            End If
        Next Ws
    End Sub

ただリンクではないので、
シートの追加・削除が行われたらこのマクロを再び走らせる必要があります。
（TAKA） 2018/08/31(金) 13:26

 =MID(CELL("filename",$A$1),FIND("]",CELL("filename",$A$1))+1,31)
 とか。。
（SS） 2018/08/31(金) 13:39

 >新しいシートを追加し「顧客一覧」
 その追加シートのシートタブを右クリックして[コードの表示]、下記コードを貼り付ける。

 シートを選択する度に一覧表を作成するので、削除・追加にも対応

 Private Sub Worksheet_Activate()
     Dim ws As Worksheet, n As Long
     Application.ScreenUpdating = False
     With Me
         .Columns(1).Clear
         For Each ws In Worksheets
             If ws.Name <> Me.Name Then
                 n = n + 1
                 .Cells(n, 1).Value = ws.Name
                 .Hyperlinks.Add .Cells(n, 1), "", ws.Name & "!A1"
             End If
         Next
     End With
     Application.ScreenUpdating = True
 End Sub

（seiya） 2018/08/31(金) 13:44

再び走らせることを考えると
前回のデータを初期化する必要があるので

    Sub Macro1()
        Dim Ws As Worksheet, K As Worksheet
        Set K = ThisWorkbook.Sheets("顧客一覧")
        K.Range("A:A").ClearContents
        K.Range("A1") = "顧客一覧リスト"
        For Each Ws In Worksheets
            If Ws.Name <> "顧客一覧" Then
                K.Cells(K.Cells(K.Rows.Count, "A").End(xlUp).Row + 1, "A") = Ws.Name
            End If
        Next Ws
    End Sub

こうですね
（TAKA） 2018/08/31(金) 13:47

みなさん、ありがとうございます。

それぞれの方法でやってみました。

ねむねむさんのはごめんなさいスタートをどうして良いか分かりませんでした。
（ゴメンなさい私が無知なんです）

TAKAさんのは式をどこに貼ったら良いかわかりませんでした。
（これまた私が無知なのです）

seiyaさんのを試してみたら一覧できました！
それぞれハイパーリンクみたくなっていたのでクリックしてみたら「参照が正しくありません」とエラーが出ました。どうしたら直りますかね？？

（事務まま） 2018/08/31(金) 14:44

あと、保存して閉じようとしたら

「次の機能はマクロなしのブックに保存できません」VBプロジェクト･･･

のメッセージが出て来て保存できず困ってしまいました
(;^_^A
（事務まま） 2018/08/31(金) 14:46

 >.Hyperlinks.Add .Cells(n, 1), "", ws.Name & "!A1"
 を
 >.Hyperlinks.Add .Cells(n, 1), "", "'" & ws.Name & "'!A1"
 としてみてくれ。
 シート名にカッコや空白があったりした場合にはシート名を'でくくらないとならない。
 また、保存時にファイルの種類をマクロ有効ブック（xlsm）で保存してくれ。
（ねむねむ） 2018/08/31(金) 14:55

 シート名にスペースを含んだものとか数字だけのものもありますね？

 それと、マクロを有効にしたブック形式で保存しないと使用できませんよ？

  Private Sub Worksheet_Activate()
     Dim ws As Worksheet, n As Long
     Application.ScreenUpdating = False
     With Me
         .Columns(1).Clear
         For Each ws In Worksheets
             If ws.Name <> Me.Name Then
                 n = n + 1
                 .Cells(n, 1).Value = ws.Name
                 .Hyperlinks.Add .Cells(n, 1), "", "'" & ws.Name & "'!A1"
             End If
         Next
     End With
     Application.ScreenUpdating = True
 End Sub

（seiya） 2018/08/31(金) 14:57

スペースあります。

出来ました！！！
ねむねむさん、seiyaさんありがとうございました！＾＾
（事務まま） 2018/08/31(金) 15:36

xlsmで保存したら保存もできました！

ちなみに、これがマクロってものなんでしょうか？？

少しづつわかってきました･･･！

感謝感激です！
（事務まま） 2018/08/31(金) 15:42

コメント返信：

[ 一覧(最新更新順) ]

[[20180831123952]] 『シート名をセルに反映できますか？』（事務まま） ページの最後に飛ぶ

[[20180831123952]]　『シート名をセルに反映できますか？』（事務まま）　ページの最後に飛ぶ