[[20110902154154]]　『セルの名前をシート名に。なければ自動追加』（すすめ）　ページの最後に飛ぶ

『セルの名前をシート名に。なければ自動追加』（すすめ）

こんにちわ。
下記のシートがあります。

  　  A     　　　  B    　　　    C     　　　   D   　　　     E
1　 KARUTE
2　
3　 取引先
4　 りんご
5　 パイン
6　 バナナ
7　 かぼちゃ
8　 きゅうり
9　 レタス
・・・

とあったとします。このA列の４行目からの名前にシート名を自動的に書き換えたいのですがマクロでできますか？？
シート１をりんご、シート２をパイン・・・・と５０個程あるのですが、
シートも自動生成されて、なおかつ自動リンクも割り当てられると嬉しいです。

ご教授下さい。

EXCEL　２００７　
os　　　WINDOWS　XP

 リストのシートが一番頭（一番左）にあるとして

 Sub sample()
 Dim Scount As Integer, las As Integer
 las = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
 For i = 4 To las
    Scount = ThisWorkbook.Worksheets.Count
    Worksheets.Add after:=Sheets(Scount)
    Sheets(Scount + 1).Name = Sheets(1).Range("A" & i).Value
 Next
 End Sub
 とこんな感じではどうでしょう？

 ＞自動リンクも割り当てられると・・・
 の意味がわからずすいません。

 ごめんなさい。
 同じシート名が無ければ・・・と言う部分を忘れていました。
 Sub sample()
 Dim Scount As Integer, las As Integer, flag As Boolean
 Dim ws As Worksheet
 las = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
 For i = 4 To las
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = Sheets(1).Range("A" & i).Value Then
           flag = True
        End If
    Next
    If flag = False Then
       Scount = ThisWorkbook.Worksheets.Count
       Worksheets.Add after:=Sheets(Scount)
       Sheets(Scount + 1).Name = Sheets(1).Range("A" & i).Value
    End If
 Next
 End Sub

自動リンクはハイパーリンクのことでした。
セルの名前をクリックすれば、そのシートが選択されるというものです。

（すすめ）

 ごめんなさい。
 テストしないで書いたら思いっきりバグった。
 自分も素人なんで、こんなんでごめんなさい。
 Sub sample()
 Dim Scount As Integer, las As Integer, n As Integer
 Dim ws As Worksheet
 las = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
 For i = 4 To las
    n = 0
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = Sheets(1).Range("A" & i).Value Then
           n = n + 1
        End If
    Next
    If n = 0 Then
       Scount = ThisWorkbook.Worksheets.Count
       Worksheets.Add after:=Sheets(Scount)
       Sheets(Scount + 1).Name = Sheets(1).Range("A" & i).Value
    End If
 Next
 End Sub
 ＞セルの名前をクリックすれば、そのシートが選択されるというものです。 
 A列のリストにハイパーリンクを設定するということですね？

 名無しさん(敬称付ける必要はないかな)のをもとにして。

  Sub sample()
    Dim Scount      As Integer
    Dim las         As Integer
    Dim Loop_CNT    As Integer
    Dim Add_Sheet   As Integer

    las = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
    Scount = ThisWorkbook.Worksheets.Count

    Add_Sheet = las - 3 - Scount + 1
    If Add_Sheet > 0 Then
        Worksheets.Add after:=Sheets(Scount), Count:=Add_Sheet
    End If

    With Sheets(1)
        For Loop_CNT = 4 To las
            Sheets(Loop_CNT - 2).Name = .Range("A" & Loop_CNT).Value
            .Hyperlinks.Add anchor:=.Range("A" & Loop_CNT), Address:="", SubAddress:="'" & .Range("A" & Loop_CNT).Value & "'!A1"
        Next
    End With
 End Sub
 (春日野馨)

ありがとうございます！
感無量。

（すすめ）

 一応念のため。

 シート名､ブック名につけられない文字
http://support.microsoft.com/kb/401030/ja

 (シスボーベー)

 もう解決ということで目に留まらないとは思うけど。

 指定文字列のシートがあるかどうかについては、１つの方法がが春日野馨さんのレスのような
シート名をループでなめる方法。そのほかに以下も。
（別途、シート名に使用可能な文字についてはシスボーベーさんの紹介ＵＲＬ等で把握しておいて）

 Sub シート有無()
    '指定シートのA1オブジェクトの有無を調べる
    '出典　k窓 http://homepage2.nifty.com/kmado/ke_m8.htm   (E00M079)
    If IsObject(Evaluate("目的のシート名!A1")) Then
        MsgBox "シートがあります"
    Else
        MsgBox "シートはありません"
    End If

    'エラー発生をチェック。個人的には感心しないと思っている方法
    Dim sh As Worksheet
    On Error Resume Next
    Set sh = Sheets("目的のシート名")
    On Error GoTo 0
    If Not sh Is Nothing Then
        MsgBox "シートがあります"
    Else
        MsgBox "シートはありません"
    End If
    Set sh = Nothing

 End Sub

 (ぶらっと)

 ええと、
 Sheets(Loop_CNT - 2).Name = .Range("A" & Loop_CNT).Value
 はシート名とセルの値を比較してるんじゃなくてシート名をセルの値にしてるんだけども。

 (春日野馨)

 >ええと、・・・・シート名をセルの値にしてるんだけども。

 すんませ～ん！　シート有無のチェックのためにシート名をなめていたのは【名無し】さんでしたね。

 (ぶらっと)

コメント返信：

[ 一覧(最新更新順) ]

[[20110902154154]] 『セルの名前をシート名に。なければ自動追加』（すすめ） ページの最後に飛ぶ

[[20110902154154]]　『セルの名前をシート名に。なければ自動追加』（すすめ）　ページの最後に飛ぶ