セルの内容と同じ内容を検索する

質問

セルの内容と同じ内容を検索する
EXCEL2003です。

SHEET1のＡ列セルをクリックし、参照先の文字が同じであれば、順々にジャンプする様なマクロを教えていただきたく。

現状の構成は次の通り。

LISTシートにリスト、SHEET1はそのリストを参照して文字列を表示させる構成になっています。

SHEET1のＤ列とLISTシートのＩ列に参照させるキー（IN_000の様なアドレス）があります。
LISTシートの分散したＡ列セルに同じ文字列が登録されています。
下記が、サンプルイメージです。

SHEET1
A1　　　　　　　　　　　　　　　　　　　　　　　　　　 　D1　　　　
=INDEX(LIST!A:A,MATCH(D1,LIST!I:I,0))　　　IN_000

LIST
A1　　　　　　　　　　　　　　　　　　　　　　　　　D1　　　　
特殊　　　　　　　　　　　　　　　　　　　　　　　　IN_000
A30
特殊　　　　　　　　　　　　　　　　　　　　　　　　IN_030
A200
特殊　　　　　　　　　　　　　　　　　　　　　　　　IN_200　

つまりSHEET1のA1,A30,A200は表示上、特殊と表示されています。
分散して表示されるので、Ａ１をクリックしたらＡ３０、Ａ３０をクリックしたらＡ２００、Ａ２００をクリックしたらＡ１に戻るという検索動作をさせたいのです。
尚、Ａ列には空白行も存在します。最終行まで検索しＡ１に戻るというジャンプをしたいです。

SHEET1のＡ列には参照式（=INDEX(LIST!A:A,MATCH(D1,LIST!I:I,0))という参照式が入っていますが、
参照先（LISTシートのＡセル内容）が空欄であれば、SHEET1のＡセルをクリックしても、そのセルのまま動かないという動作も併せてお願いしたく。
クリックしてジャンプ検索するのは、Ａ列限定です。
他のセルには同じ文字列が多数存在し、クリックしたり入力もあります。

※マクロに関して、初心者なのでベタの回答でお願いできますでしょうか

回答No.1

kmetu · ベストアンサー

クリックでというのは無理なのでダブルクリックにしました。

マクロの設定の仕方から説明しておきます。該当シートを開いてALT＋F11を押すとVBEが開きますので、左の窓の該当シート名の書かれたところを右クリックすると右側に白い窓が出現しますのでそこに以下のコードをコピーしてください。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Err GoTo Myerr:
Dim MyRange As Range
Dim FirstRow As Integer

Application.EnableEvents = False
If Target.Column = 1 And Target.Value <> "" Then
If Target.Row = Range("A" & Rows.Count).End(xlUp).Row Then
FirstRow = 1
Else
FirstRow = Target.Row
End If
With Range("A" & FirstRow & ":A" & Range("A" & Rows.Count).End(xlUp).Row)
Set MyRange = .Find(Target.Value, LookIn:=xlValues, After:=ActiveCell)
If FirstRow = Target.Row Then
Set MyRange = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Find(Target.Value, LookIn:=xlValues, After:=ActiveCell)
MyRange.Select
Else
MyRange.Select
End If
End With
End If
Application.EnableEvents = True

Myerr:
Application.EnableEvents = True
End Sub

お礼

回答ありがとうございました。助かりました。

補足

回答ありがとうございます。

教えていただいた内容で、うまく動作しました。
応用で、もう１点教えていただきたいことがあります。
検索するセルに関しＡ列からＢ列用を作成しました。

下記内容です。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Err GoTo Myerr:
Dim MyRange As Range
Dim FirstRow As Integer

Application.EnableEvents = False
If Target.Column = 1 And Target.Value <> "" Then
If Target.Row = Range("B" & Rows.Count).End(xlUp).Row Then
FirstRow = 1
Else
FirstRow = Target.Row
End If
With Range("B" & FirstRow & ":B" & Range("B" & Rows.Count).End(xlUp).Row)
Set MyRange = .Find(Target.Value, LookIn:=xlValues, After:=ActiveCell)
If FirstRow = Target.Row Then
Set MyRange = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row).Find(Target.Value, LookIn:=xlValues, After:=ActiveCell)
MyRange.Select
Else
MyRange.Select
End If
End With
End If
Application.EnableEvents = True

Myerr:
Application.EnableEvents = True
End Sub

ＡをＢに変えたマクロなのですが動作しません。
どこがおかしいのか教えていただきたく。

回答No.2

kmetu

> ＡをＢに変えたマクロなのですが動作しません。
> どこがおかしいのか教えていただきたく。

B列をダブルクリックしていくということですね。

If Target.Column = 1

↓

If Target.Column = 2

としてください。ここだけは列をA列を1として2,3,4と右へ数えて数値で指定する仕様となっています。

お礼

回答ありがとうございます。うまく動作しました。検索セルが結合しているとエラーになってしまうので、別途質問させていただきます。