EXCELでハイパーリンク自動生成

質問

ある管理表を作成しています。これは、管理表、対応表という2種類で構成していますが、管理表のシートの１つのセルに
ある言葉を入力すると、その管理表XLSの中に新たな対応表のシートを自動で作成してそのシート内の、ある場所（セル）とシート名にその言葉が自動で作成されるようにしたいのですが、できるのでしょうか？それとも、やはり、言葉入力のあと、手動でシートをコピー作成して、ハイパーリンクを作るしかないのでしょうか？教えて下さい。

回答No.4

misatoanna · ベストアンサー

削除マクロを実行する時点のＡ列はどうなっていますか？
こちらでは、Ａ列のデータ範囲に空白セルが無いとエラーを起こすようですが、
場所は
　Selection.SpecialCells(xlCellTypeBlanks).Select
でした。

とりあえず、 Columns("B:B").Select　以下の数行の間に、次の※印の２行を挿入
してみてください。

Columns("B:B").Select
On Error GoTo Pfm　　　'※
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
　Pfm:　　　'※

あとは――
見当つきませんが、Excelのバージョンの違いによるのかも知れません。
これでもエラーが出たり処理結果が違う(削除されないシートがあったり、余分に
削除されたり)場合は、結果を具体的にお知らせください。

お礼

おかげさまで、できました。
ありがとうございました。

回答No.3

misatoanna

> 実際に入力する位置は管理表のＡの列にしています。

エラーが発生したのはどの行ですか？
シート名以外に次の３か所を書き換えましたか？

削除コマンドの上から６行目を書き換えます。
　Columns("B:B").Select　　→　　Columns("A:A").Select

同じく真中あたりの２行を書き換えます。
　For j = 2 To Range("B65536").End(xlUp).Row
　　　If Sheets(i).Name = Sheets("MGR").Cells(j, 2).Value Then
　　　　↓
　For j = 2 To Range("A65536").End(xlUp).Row
　　　If Sheets(i).Name = Sheets("MGR").Cells(j, 1).Value Then

補足

すみません、試してみましたが、同じエラーが出て、
デバックの指示が出て、Selection.EntireRow.Delete
が黄色表示になります。

回答No.2

misatoanna

正直なところ、マクロにつきましては私も初心者ですので、内容がごちゃごちゃしている上、バグが
あるかも知れませんが――　　　^^;

前回のと差し替えてください。

＜変更内容＞
1.ハイパーリンクの設定
2.同一データがある場合は警告
3.その他
'
Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim i
　　On Error Resume Next
　　If Target.Column <> 2 Then Exit Sub
　　If Target.Row = 1 Then Exit Sub
　　If Target.Value = "" Then Exit Sub
　　For i = 1 To Sheets.Count
　　　　If Sheets(i).Name = Target.Value Then
　　　　　　MsgBox "同じ名前のデータがあります"
　　　　　　Target.ClearContents
　　　　　　Target.Select
　　　　　　Exit Sub
　　　　End If
　　Next
　　Application.ScreenUpdating = False
　　Sheets("Form").Copy After:=Sheets(WorksheetFunction. _
　　　　　　　　CountA(Range(Cells(1, 2), Cells(Target.Row, 2))))
　　　　ActiveSheet.Name = Target.Value
　　　　ActiveSheet.Range("B3") = Target.Value
　　Sheets(Target.Value).Range("C3").Select
　　　　ActiveSheet.Visible = True
　　　　ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", _
　　　　　　　　SubAddress:="MGR!B1", TextToDisplay:="管理表へ"
　　Sheets("MGR").Activate
　　　　ActiveSheet.Hyperlinks.Add Anchor:=Target, Address:="", _
　　　　　　　　SubAddress:=Target.Value & "!B3", TextToDisplay:=Target.Value
　　Application.ScreenUpdating = True
End Sub

--------------------------------
シートを削除するルーティンは、別プログラムでバッチ処理することにしました。
Visual Basic Editor の　[挿入]-[標準モジュール]　に、以下をコピーします。
'
Sub DelSheet()
　　Dim i, j, Chk
　　Sheets("MGR").Select
　　Application.ScreenUpdating = False
　　Application.DisplayAlerts = False
　　Columns("B:B").Select
　　　　Selection.SpecialCells(xlCellTypeBlanks).Select
　　　　Selection.EntireRow.Delete
　　On Error Resume Next
　　For i = Sheets.Count To 3 Step -1
　　　　For j = 2 To Range("B65536").End(xlUp).Row
　　　　　　If Sheets(i).Name = Sheets("MGR").Cells(j, 2).Value Then
　　　　　　　　Chk = 1
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　　　If Chk = 0 Then Sheets(i).Delete
　　　　Chk = 0
　　Next
　　Application.DisplayAlerts = True
　　Application.ScreenUpdating = True
End Sub

任意の時点で、[ツール]-[マクロ]-[マクロ]　から　DelSheet　を選択して実行します。

補足

どうも、ありがとうございます。ハイパーリンクはうまく行きました。シートの削除の方は、やってみましたがエラー１００４　重複する選択範囲に対してそのコマンドは利用できません。と出て、うまくいきませんでした。実際、「MGR」を管理表、「Form」を対応表に書き換えているのと、実際に入力する位置は管理表のAの列にしています。

回答No.1

misatoanna

マクロ処理になりますね。
以下はだいぶ手を抜いた例ですが、このような内容でしょうか。

二枚のシートがあるとします。
　　１枚目の名前は　MGR　で、管理表です。
　　２枚目の名前は　Form　で、対応表の様式です。
１枚目のＢ列セルに文字入力すると、それと同じ名前の管理表が作成され、その
B3にも１枚目で入力された文字が表示されます。

1.次のコードをコピーしてから、MGRシートタブの右クリックメニューの「コードの
　表示」を選択します。
　　Private Sub Worksheet_Change(ByVal Target As Range)
　　　　Application.ScreenUpdating = False
　　　　If Target.Column <> 2 Then Exit Sub
　　　　If Target.Value = "" Then Exit Sub
　　　　Sheets("Form").Copy After:=Sheets(Sheets.Count)
　　　　ActiveSheet.Name = Target.Value
　　　　ActiveSheet.Range("B3") = Target.Value
　　　　Sheets("MGR").Activate
　　　　Application.ScreenUpdating = True
　　End Sub
2.開いた画面にコピーしたものを貼り付けて閉じます。
3.以上の操作が終了したら、MGRシートのB1に何かを入力してみてください。

シートの削除までは対応させていません。

お礼

ありがとうございます。マクロ処理かな？とは思ったんですが、マクロが全然分からないので質問しました。もしよければ、シートの削除と相互のハイパーリンクが自動で生成できればとも思うのですが、できますでしょうか？