VBA初心者です。A1からA11にデータがあります。画面のテキストボッ

質問

VBA初心者です。A1からA11にデータがあります。画面のテキストボックスに例えば、山と入力し、ボタンをクリックする度、その文字を含むセルに色をつけようとしています。山を含むデータが3個あれば3回ボタンをクリックしないと終了しないというわけです。

データに山の文字を含むセルが複数あった時、下のプログラムでは1回ボタンをクリックした時、色が付きます。2回目以降は(1)でエラーです。

山と言う文字がA3、A6、A9にあれば、1回目はA3を検索、2回目以降はA4から検索しA6で着色、3回目はA7から検索してA9で着色、最後の行までいけばデータは以上、というメッセージを表示ということです。

プログラムは検索部分だけ記載しています。

'データ領域、最終行取得
Worksheets("Sheet1").Activate
Range(Cells(2, 1), Cells(maxRow, 1)).CurrentRegion.Select

If flag = False Then
Set c = Worksheets("Sheet1").Range(Cells(2, 1), Cells(maxRow, 1)).CurrentRegion.Find(What:=myKey, LookIn:=xlValues, lookat:=xlPart, SearchOrder:=xlByColumns)
c.Interior.ColorIndex = 4
flag = True
Else
(1) Set d = Worksheets("Sheet1").Range(Cells(2, 1), Cells(maxRow, 1)).CurrentRegion.FindNext(c)
d.Interior.ColorIndex = 4
End If

flagは
Option Explicit
Dim flag As Boolean
で宣言。flagは、
Private Sub UserForm_Click()
flag = False
End Sub
でフォームロード時にfalseとします。
Flagはテキストボックスに入力した文字をクリアするボタンをクリックした時再びfalseに設定します。

Flagがfalseの時は1度目の検索。2度目以降はTrue。やりたいことは、
1,1度目の検索のセルのアドレスをどこかに保存し、2回目以降のボタンのクリック(Flagがtrue時)はそのセルの次のセルから検索を行う。
2,2回目以降ヒットしたセルの次のセルから検索する。
3,データの最後のセルまで検索した時、メッセージで、"検索終了"といった表示を出す。

(1)はわからないので不完全のプログラムのまま記載しています。特に、1回目の検索したセルのアドレスをどう取得し、Range(Cells(2, 1), Cells(maxRow, 1))に代入すればよいのかわかりません。

Flagをたてるというのはいいアイデアに思ったのですが・・・
(1)前後のプログラムででどうやれば、1回目の検索時(Flagがfalseの時)のセルのアドレスを取得し、2回目以降のボタンのクリック時まで保存し、(1)に代入していけばよいのかわかりません。

ここまではナントカできたのですが・・・お助けください、よろしくお願いします。

回答No.2

hige_082 · ベストアンサー

userformにtextbox1、commandbutton1を作成し
以下を貼り付けて試してください

'userformへ
Option Explicit
'変数の宣言
Dim flag As Boolean
Dim c As Range
Dim d As Range

'検索処理
Private Sub CommandButton1_Click()
'textbox1が未入力なら処理中止
If TextBox1.Value = "" Then Exit Sub
'初めてか2回目以降で処理の分岐
If flag = False Then
初めての検索処理
Set c = Cells.Find(After:=Cells(Rows.Count, Columns.Count), What:=TextBox1.Value, LookIn:=xlValues, lookat:=xlPart, SearchOrder:=xlByColumns)
c.Interior.ColorIndex = 4
初めての結果(range)を保存しておく
Set d = c
flag = True
Else
'2回目以降の検索処理
Set d = Cells.Find(After:=d, What:=TextBox1.Value, LookIn:=xlValues, lookat:=xlPart, SearchOrder:=xlByColumns)
d.Interior.ColorIndex = 4
'保存しておいた結果と今回の検索結果を比較して
'1周してきたと判断して終了を表示
If c.Address = d.Address Then MsgBox "検索終了"
End If
End Sub

Private Sub TextBox1_Change()
'検索値の変更で各保存していた値のリセット
flag = False
Set c = Nothing
Set d = Nothing
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'userform終了時にお約束の処理
Set c = Nothing
Set d = Nothing
End Sub

以上　参考まで

うまく行ったら、質問のコードと比較してみてね
参考まで

お礼

OKWAVEのビギナーなもので、ここにお礼が書けるとは知りませんでした。助かりました。ありがとうございます。まだVBAを勉強し始めたものです。本屋に行っても、基本ばかり書かれている本は山のようにありますが、イザこの機能はどうやって、となると殆ど役に立ちません。

そんなわけで、こんな機能はどうやって組むのか、と自問自答とコピペを繰り返しながら試行錯誤の毎日です。またネットで見かけたら質問に答えてやってください。よろしくお願いします。

回答No.1

watabe007

参考に
Sub Test()
　　Dim c As Range
　　Dim FirstAddress As String
　　Dim i As Long
　　Dim myflg As Boolean

　　'myKey = "山"

　　Worksheets("Sheet1").Activate
　　With ActiveSheet.Range("A1", Cells(Rows.Count, "A").End(xlUp))
　　　　Set c = .Find(What:=myKey, LookIn:=xlValues, lookat:=xlPart, SearchOrder:=xlByColumns)
　　　　If c Is Nothing Then
　　　　　　MsgBox myKey & " は、見つかりませんでした。", 64
　　　　　　Exit Sub
　　　　End If
　　　　FirstAddress = c.Address
　　　　Do
　　　　　　If c.Interior.ColorIndex <> 4 Then
　　　　　　　　c.Interior.ColorIndex = 4
　　　　　　　　myflg = True
　　　　　　End If
　　　　　　Set c = .FindNext(c)
　　　　　　If FirstAddress = c.Address Then
　　　　　　　　MsgBox "データは以上", 64
　　　　　　　　Exit Do
　　　　　　ElseIf myflg Then
　　　　　　　　Exit Do
　　　　　　End If
　　　　Loop
　　End With
　　Set c = Nothing
End Sub