エクセルVBAで指定したセルへジャンプするコード

質問

こんにちは。ファイル内の各シートのセルに順にジャンプするVBAのコードを教えていただけないでしょうか。以下のような条件や構成にしたいと考えています。

・「操作ブック」と名づけたファイルに「設定」シートをつくり次のようにする
A列B列の2行目以下に「シート名」「セル番地」を入力し、ジャンプするセルを入力
(例)
A B←うまく表になりませんがB列がセル番地です
Sheet1 E9
Sheet1 U7
Sheet2 S2

・ジャンプする先は「操作ブック」内ではなく、開いている“もうひとつのブック内”の各シート

・ジャンプして選択したセルに一時的に色をつけ、次に進む時は色を元に戻す(難しいのであれば結構ですが、できればすごくうれしいです)

・「設定」シートに入力した上から下に順にジャンプする。ジャンプする前にメッセージで、「次に進みますか？」と聞き、「はい」で次のセルにジャンプする

という設定にしたいのですが、マクロでジャンプの記録をとってみましたが、私にはとてもできない記述なので、教えていただきたく参りました。
よろしくお願いします。

回答No.1

Nayuta_X · ベストアンサー

Sub Macro1()
Dim ThisWorkbook_Name As String
Dim Workbook_Name As String
Dim ThisSheet_Name As String
Dim Sheet_Name As String
Dim ThisRange_Name As String
Dim Range_Name As String
Dim I As Integer
Dim Ans As Integer

ThisWorkbook_Name = ThisWorkbook.Name 'マクロが、入っているシートの名前
ThisSheet_Name = ActiveSheet.Name '設定シート

Workbook_Name = "Book2" '開いている“もうひとつのブック”の名前

' Sheet_Name = "Sheet1"
' Range_Name = "B5"
'

I = 0

' 開きたい　シートは、A列の３行目から　セル番号は、B列の３行目から記入すること。

Do

Workbooks(ThisWorkbook_Name).Activate

If Range("A3").Offset(I, 0).Value = "" Then Exit Do 'A列の３行目以下が、空白なら
'データが、ないなら　終わる

Sheet_Name = Range("A3").Offset(I, 0).Value
Range_Name = Range("B3").Offset(I, 0).Value

Windows(Workbook_Name).Activate
Sheets(Sheet_Name).Select
Range(Range_Name).Select
Selection.Interior.ColorIndex = 6

Ans = MsgBox("「次に進みますか？」", vbYesNo)

If Ans = vbYes Then
I = I + 1
Selection.Interior.ColorIndex = xlNone
Else
Selection.Interior.ColorIndex = xlNone
Exit Do
End If

Loop

End Sub

補足

Nayuta_Xさんこんばんは。すばらしいと思いました。この出来栄えもさることながら、こんな短時間に、相手のリクエストを全て理解して仕上げる技術がまねできないことだと思い、感動しました!
ひとつだけ仕様で尋ねてもいいでしょうか？
検索するブックで、今回のマクロではBook2になっていて、私もテストする際、名前をBook2にしましたが、開いているブックでどんなブック名でも検査できるようにはならないでしょうか？
ずうずうしいですが、よろしくお願いします。

回答No.3

merlionXX

マクロを記述してあるBOOKではないほうのBOOK名を指定するんじゃなく、何という名前でも開いていれば対象にしたいという事ですね？

#1さんのコードをお借りしてやってみました。
もう一つの開いているBOOK名を簡単に取得する方法を思いつけなかったので、BOOKが2つ開いていて、自分じゃないほうの名前という取得方法をとりました。

Sub test01()

Dim x As String
Dim Workbook_Name As String
Dim ThisSheet_Name As String
Dim Sheet_Name As String
Dim ThisRange_Name As String
Dim Range_Name As String
Dim I As Integer, n As Integer
Dim Ans As Integer

ThisSheet_Name = ActiveSheet.Name '設定シート

Select Case Workbooks.Count
Case 1
MsgBox "他に開いているBOOKはありません。"
Exit Sub
Case 2
For n = 1 To 2
If Workbooks(n).Name <> ThisWorkbook.Name Then
x = Workbooks(n).Name
End If
Next
Case Else
MsgBox "他に開いているBOOKが複数のため対象を特定できません。"
Exit Sub
End Select

Workbook_Name = x '開いている“もうひとつのブック”の名前

I = 0

' 開きたい　シートは、A列の３行目から　セル番号は、B列の３行目から記入すること。

Do While (1)

With ThisWorkbook.Sheets(ThisSheet_Name)

If .Range("A3").Offset(I, 0).Value = "" Then
MsgBox "データがなくなりました。"
ThisWorkbook.Activate
Exit Do
End If
'A列の３行目以下が、空白なら終わる

Sheet_Name = .Range("A3").Offset(I, 0).Value
Range_Name = .Range("B3").Offset(I, 0).Value

End With

Windows(Workbook_Name).Activate
Sheets(Sheet_Name).Select
Range(Range_Name).Select
Selection.Interior.ColorIndex = 6

Ans = MsgBox("「次に進みますか？」", vbYesNo)

Selection.Interior.ColorIndex = xlNone

If Ans = vbYes Then
I = I + 1
Else
Exit Do
End If

Loop

End Sub

お礼

merlionXXさんこんばんは。完璧にできていました。ありがとうございました。今回最初にNayuta_Xさんが元のコードをご提示いただいたので、恐縮ですが、次点とさせていただきますが、今後ともよろしくお願いします。

回答No.2

Nayuta_X

たとえば、 Book2を開いて Book2から
ツール⇒マクロ⇒マクロ⇒Macro1の実行をすると　動くようにするには、

Workbook_Name = "Book2" '開いている　を
Workbook_Name =ActiveWorkbook.Name 　'に変更します。
'尚、指定した　シートが、存在しないと　エラーになります。
'エラー処理は、ご自分で考えて　見てください。
'どうしても解らないときは、下記　URL で、検索するか
'再度　質問して下さい。

参考URL：

http://www2.moug.net/bbs/exvba/

お礼

お付き合いいただきありがとうございました。解決しました。こんなに
はやく解決できるとは思いませんでした。