検索のループについて

質問

いつもお世話になっております。
Ｆ列に”s”という値がついたセルがあれば、インプットボックスでＡかＢを入力したいです。

下記は、1つのセルだけなら機能するのですが、複数になると2つ目から動きません。
よろしくお願いいたします。

Sub 検索()
Dim Rng

Sheets("全愛知県").Select
Columns("F:F").Select
Selection.Find(What:="s", After:=Range("F1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Activate

Rng = Application.InputBox(Prompt:="「Ａ」か「Ｂ」を入力してください。")
ActiveCell.Offset(0, -4).Select
ActiveCell = Rng

End Sub

回答No.4

real beatin（@realbeatin） · ベストアンサー

（＃２／２、以下、前の投稿の続きです）
///
次にユーザーフォームですが、
　言い難いことですが、作成済のユーザーフォームは、
　一回すべて削除（方法は下記【註１】）してから始めた方が、
　期待した結果を得るのに近道になるかと思いますので、、、。
添付画像を参考にコントロール（全６）を配置してください。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
UserForm1
　┣　Label1　　　　　　Ｆ列の検索セル、現在対象となるＦ列の値を表示
　┣　Frame1　　　　　　オプションボタンを収めるのに必要なフレーム
　　　┣　OptionButton1　　例示で"A"に対応する選択ボタン（オプションボタン）
　　　┗　OptionButton2　　例示で"B"に対応する選択ボタン（オプションボタン）
　┣　Label2　　　　　　（Ｂ列に既定値があればそれを）選択した入力値を表示
　┗　CommandButton1　　入力値を確定して次の検索へ進むボタン
（[×]閉じるボタン）　　以降の処理を中止する
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
注意点として
　　必ず、同種のコントロールは上から（添付画像参照）順番に追加する
　　　→順番を違えると、コントロールのオブジェクト名がずれてＮＧ
　　必ず、Frame1の上にOptionButton1、OptionButton2を収める。
　　　→正しく機能させる為必須。
　　　→試しにFrame1をドラッグしてOptionButton1、OptionButton2が連動して動けばＯＫ
追加する順番がずれると、各コントロールのオブジェクト名もずれてしまい、
正しく機能しないか、オブジェクトが見つからない系のエラーになります。

選択した結果を出力する処理は、すべてユーザーフォーム側で行います。
' ' 〓〓〓〓〓 以下、UserForm1 モジュール 〓〓〓〓〓

' ' /// ユーザーフォームを最初に読み込む時に 固定的な設定をする
Private Sub UserForm_Initialize()
　　OptionButton1.Caption = "A"　'　選択候補を表示文字列として指定
　　OptionButton2.Caption = "B"　'　〃
End Sub

' ' /// ユーザーフォームを表示/再表示する度に 変動する（ActiveCellに連動した）設定をする
Private Sub UserForm_Activate()
　　' ' 上側のラベルに、現在の検索結果セルの値を表示
　　Label1.Caption = ActiveCell.Value
Dim v, i As Long
　　' ' 現在の検索結果セルの ４つ左のセル の値 を取得
　　v = ActiveCell.Offset(, -4).Value
　　' ' 現在の検索結果セルの値が空ならば、以下の処理は実行しない
　　If IsEmpty(v) Then Exit Sub
　　' ' OptionButtonをオブジェクト名のインデックスでループ
　　For i = 1 To Frame1.Controls.Count
　　　　' ' OptionButtonをオブジェクト名を指定して取得
　　　　With Controls("OptionButton" & i)
　　　　　　' ' 現在の検索結果セルの ４つ左のセル の値 と
　　　　　　' ' OptionButton の表示文字列 が 一致するものがあれば、
　　　　　　' ' OptionButtoを選択状態にする
　　　　　　If .Caption = v Then
　　　　　　　　If .Enabled And .Visible Then
　　　　　　　　　　.Value = True
　　　　　　　　　　Call OptionButtons_Click(i)
　　　　　　　　End If
　　　　　　　　Exit For
　　　　　　End If
　　　　End With
　　Next i
End Sub

' ' /// OptionButtonのイベント
Private Sub OptionButton1_Click()
　　Call OptionButtons_Click(1)
End Sub
Private Sub OptionButton2_Click()
　　Call OptionButtons_Click(2)
End Sub

' ' /// OptionButtonイベントを受けるサブプロシージャ
Private Sub OptionButtons_Click(ByVal nIndex As Long)
　　' ' 下側のラベルに、現在選択中のOptionButtonの値を表示
　　Label2.Caption = Controls("OptionButton" & nIndex).Caption
　　' ' 現在選択中のOptionButtonのインデックスを記録しておく。
　　Frame1.Tag = nIndex
End Sub

' ' /// CommandButton1のイベント　[登録]
Private Sub CommandButton1_Click()
　　' ' 現在の検索結果セルの ４つ左のセル に 下側のラベルの表示文字列 を 転記
　　ActiveCell.Offset(, -4).Value = Label2.Caption
　　' ' 下側のラベルの表示文字列 を 空に
　　Label2.Caption = ""
　　On Error Resume Next
　　' ' 現在選択中のOptionButtonの値をFalseに
　　Controls("OptionButton" & Frame1.Tag).Value = False
　　On Error GoTo 0
　　' ' ユーザーフォームを非表示に
　　Me.Hide
End Sub

' ' 〓〓〓〓〓 以上、UserForm1 モジュール 〓〓〓〓〓

【註１】既存のユーザーフォームを削除する方法
　ＶＢＥ画面上で
　　プロジェクトエクスプローラー＝通常は[プロジェクト - VBAProject]とタイトルされたウィンドウ
　　　内で、[UserForm1]を右クリック
　　　　→ポップアップメニューの中から、[UserForm1 の解放(_R)]をクリック
　　　　　→表示されたダイアログで、[いいえ]をクリック

（＃２／２、全２稿以上です）

お礼

realbeatinさま、ありがとうございました。

想像以上に大変でした。が
ユーザーフォームにラベルを配置するとは、さすがです。
一目でボタンの押し間違いが判断できて、その場で訂正できる！

とても勉強になりました。ありがとうございました。

回答No.3

real beatin（@realbeatin）

No.1お礼欄、No.2補足欄へのレスです。

ご苦労様です。
> オブジェクトが必要です。というエラーが出ました。
部分的には> UserForm.Show <正しいオブジェクト名は UserForm1
という指定ミスが原因かと思いますが、
もう少し包括的にこちらがリードするようにしようと思います。

＃投稿文字数制限に係るので、以下、２稿に分けます。
（＃１／２）

少しだけ、ユーティティーを加味した内容でお応えします。
◆現在の検索結果セルの値
と
　現在の検索結果セルの ４つ左のセル の値
をそれぞれふたつのラベルに表示して、
確認しながらの作業や、チェック目的での利用を可能にしました。
◆オプションボタンで選択
　→現在の検索結果セルの ４つ左のセルへの出力候補をラベルに表示して、
　　→確認してから確定[登録]
◆ユーザーフォームの閉じる[×]ボタンで連続検索を中止できるようにしました。
◆オプションボタンに表示する選択候補を動的に指定可能にする為に、
　UserForm_Initialize()　で表示文字列を指定するように書きました。
　もし、恒に固定であれば、UserForm_Initialize()は省いて、
　デザイン画面から、オプションボタンの.Captionを指定してください。

///
まず、No.1のコードをユーザーフォーム仕様に変更（★）します。
実コードの行数にすると（要らなくなった変数宣言を含め）
５減２増、です。

' ' ///
Sub ReW9077713r()
Dim rngFound As Range　'' 検索結果検索結果
Dim n1stRow As Long　'　検索１回目の行位置

　　Sheets("全愛知県").Select
　　With Columns("F:F")
　　　　.Select

　　　　' ' 検索１回目は　range.Find メソッド
　　　　Set rngFound = .Find( _
　　　　　　What:="s", After:=Range("F1"), LookIn:=xlValues, _
　　　　　　LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)

　　　　' ' 検索結果が空でない場合は、１回目に見つかったセルの行位置を記録しておく。
　　　　If Not rngFound Is Nothing Then n1stRow = rngFound.Row

　　　　' ' 検索結果（rngFound）が空になるまでは、Do ... Loop 内の記述を実行。
　　　　Do Until rngFound Is Nothing
　　　　　　' ' 検索結果（rngFound）セルをアクティブに。
　　　　　　rngFound.Activate

　　　　　　' ' ユーザーフォームを表示または再表示。
　　　　　　' ' 入力情報の選択/反映等の処理はすべてユーザーフォーム側で行う。
　　　　　　UserForm1.Show　'　★

　　　　　　' ' ユーザーフォームの閉じる[×]ボタンが押されていた場合は以降の処理を中止する。
　　　　　　If UserForms.Count = 0 Then MsgBox "検索中止": Exit Sub　'　★

　　　　　　' ' 検索２回目以降は　range.FindNext メソッド
　　　　　　' ' 「Columns("F:F")の範囲で」「検索結果（rngFound）の次に見つかるセルを」「.FindNextする」
　　　　　　Set rngFound = .FindNext(rngFound)

　　　　　　' ' .FindNextを繰り返して無限ループになることを避ける意味で、
　　　　　　' '　現在の検索結果（rngFound）の行位置が１回目の検索結果と同値ならループを抜ける。
　　　　　　If rngFound.Row = n1stRow Then Exit Do
　　　　Loop

　　End With

　　MsgBox "検索終了"
End Sub
' ' ///
（以上、＃１／２、次の投稿に続きます）

回答No.2

real beatin（@realbeatin）

自己レスです。
> ユーザーフォームでリストボックスやコマンドボタン
> 等を使って選択するだけにした方が
例を挙げるなら、オプションボタンを筆頭にするべきでしたね。
まぁ、何れにしても、実際の必要に即したＵＩを選べばいい、ので、
InputBox メソッドが最善という判断も場合によってはあるのかも知れませんが、
一般論としては、想定しない入力をされてしまうようなことがあると、
それはシステムとしての脆さに繋がりますし、なるべく面倒は後に残さない方が吉、
というようなことを伝えたかっただけです。
勿論、この件についてのご相談があれば、引き受けるつもりで居りますので。
以上です。

補足

realbeatinさん、お世話になります。

ユーザーフォームにオプションボタンを「A」と「B」２つ作り、コマンドボタンで「登録」を作りました。

Private Sub UserForm_Click()
Dim myMSG As String
If OptionButton1.Value = True Then
myMSG = OptionButton1.Caption
End If
If OptionButton2.Value = True Then
myMSG = OptionButton2.Caption
End If

myMSG = myMSG & vbCrLf & "が選択されています"
MsgBox myMSG
End Sub

Private Sub CommandButton1_Click()
ActiveCell.Offset(0, -4) = CommandButton1.Text

End Sub

と、ユーザーフォームにコードを書きました。
' ' ///
Sub ReW9077713()
・
・
vRtn = Application.InputBox(Prompt:="「Ａ」か「Ｂ」を入力してください。", Type:=2)
を
vRtn = UserForm.Show
に変更しました。

オブジェクトが必要です。というエラーが出ました。
私にはここまでが限界です。
以後、よろしくお願いいたします。

回答No.1

real beatin（@realbeatin）

こんにちは。

たぶんこういうことかな、と思うニーズに対して、
必要最低限の（余計なものは何も足さない）設計でお応えします。

強いて今後の課題を言えば、"「Ａ」か「Ｂ」を入力してください。"という要求ならば、
ユーザーフォームでリストボックスやコマンドボタン
等を使って選択するだけにした方が、
ユーザーにとっても開発者にとっても生産効率を管理する立場にとっても、
より幸せになれるように思います。

技術的なポイントは、コメントとして添え書きしておきました。
range.FindNext メソッドについては一応、
ＶＢＡのヘルプを読んでみて、あちらの使用例もチェックしておくとベターです。

何か不足や疑問が残った場合は、補足欄に書いてください。

' ' ///
Sub ReW9077713()
Dim vRtn　'　InputBox メソッドの受け皿
Dim rngFound As Range　'' 検索結果検索結果
Dim n1stRow As Long　'　検索１回目の行位置

　　Sheets("全愛知県").Select
　　With Columns("F:F")
　　　　.Select

　　　　' ' 検索１回目は　range.Find メソッド
　　　　Set rngFound = .Find( _
　　　　　　What:="s", After:=Range("F1"), LookIn:=xlValues, _
　　　　　　LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)

　　　　' ' 検索結果が空でない場合は、１回目に見つかったセルの行位置を記録しておく。
　　　　If Not rngFound Is Nothing Then n1stRow = rngFound.Row

　　　　' ' 検索結果（rngFound）が空になるまでは、Do ... Loop 内の記述を実行。
　　　　Do Until rngFound Is Nothing
　　　　　　' ' 検索結果（rngFound）をアクティブに。
　　　　　　rngFound.Activate

　　　　　　' ' InputBox メソッドでユーザーによる入力情報を取得。（データの型を文字列型で指定ておきます）
　　　　　　vRtn = Application.InputBox(Prompt:="「Ａ」か「Ｂ」を入力してください。", Type:=2)
　　　　　　' ' InputBox メソッドの戻り値が文字列型ならば（キャンセルされていなければ）
　　　　　　If VarType(vRtn) = vbString Then
　　　　　　' ' 検索結果（rngFound）の４列左のセルにvRtnを格納
　　　　　　　　rngFound.Offset(0, -4).Value = vRtn
　　　　　　End If

　　　　　　' ' 検索２回目以降は　range.FindNext メソッド
　　　　　　' ' 「Columns("F:F")の範囲で」「検索結果（rngFound）の次に見つかるセルを」「.FindNextする」
　　　　　　Set rngFound = .FindNext(rngFound)

　　　　　　' ' .FindNextを繰り返して無限ループになることを避ける意味で、
　　　　　　' '　現在の検索結果（rngFound）の行位置が１回目の検索結果と同値ならループを抜ける。
　　　　　　If rngFound.Row = n1stRow Then Exit Do
　　　　Loop

　　End With

　　MsgBox "検索終了"
End Sub
' ' ///

お礼

realbeatinさん、いつもありがとうございます。

1行1行説明いただいたので、なんとか理解できました。
もちろん、希望通りに動きました。

インプットボックスの件ですが、リストで選択できたらとも考えたのですが、あまりにハードルが高そうでやめてしまいました。

教えていただけるということで、これからユーザーフォームを作成し、また質問させていただきます。
引き続きよろしくお願いいたします。