【VBA】FindNextで「１以上の整数値を全て」検索できるコード

🔶【１１月６日更新】コードが不完全だったので修正しました。

FindとFindNextを使うと、検索値に該当するデータを列挙することができます。

indexやmatchを使うと検索最初のデータは拾えますが、該当値が複数あるときは、

ダメですね。

ネットを探してみると、FindとFindNextで、「検索値を１つ」指定して検索するメソッドはあったのですが、「１以上の整数値全て」を検索できるようなコードは見当たりませんでした。

私なりに、コードを書いてみたので、備忘録として載せておきます。

説明）

Range("AJ53:AJ92")を検索範囲にします。

検索範囲で１以上の値が無ければ「該当者なし」と表示します。

１以上の値がある場合は、検索値＝１から始め、

検索範囲から左に３３列目（Ｃ列）の値を、Range("AO54:AO93")

に転記します。また、検索ヒットした整数を、Range("AU54:AU93")に転記します。

転記の際は、すでにデータがあるセルは飛ばして列挙していきます。

というコードです。

使い道）

出席簿で、停止・忌引がある児童名を、全て表示する時などに使えると思います。

--------------------------------------------

Sub 範囲内で１以上の整数値を全て検索()

Dim myRange As Range
Dim meRange As Range
Dim myAddress As String
Dim i, r, rmax As Integer

Set meRange = ActiveSheet.Range("AJ53:AJ92") '★検索対象列範囲

rmax = Int(WorksheetFunction.Max(meRange)) '範囲最大値

If rmax = 0 Then '★最大値が０なら終了
MsgBox "該当者はいません。"
Exit Sub
End If

r = 1 '★最大値が０でなければ、r=1から検索開始

mainpro: '★ラベル

Set myRange = meRange.Find(r, LookIn:=xlValues, LookAt:=xlWhole) '★完全一致で検索★
'↑【重要】ここを書かないと、12を検索すると、1と2も拾ってしまう。

If r > rmax Then Exit Sub '★rが範囲最大値を超えたら終了★

If myRange Is Nothing Then '★検索値が無ければr+1する
GoTo radd
End If

If Not myRange Is Nothing Then
myAddress = myRange.Address
i = 54 + WorksheetFunction.CountIf(Range("AO54:AO93"), "<>")
Do

Cells(i, "AO").Value = myRange.Offset(, -33).Value '★
Cells(i, "AU").Value = myRange.Offset(, 0).Value '★

Set myRange = meRange.FindNext(After:=myRange) '

i = i + 1 '★

Loop Until myRange.Address = myAddress

radd: '★ラベル

r = r + 1 '★

GoTo mainpro

End If

End Sub

--------------------------------

検索値でForループを回さず、ラベルを付けて＋１ずつ処理していくところを工夫してみました。

備忘録、備忘録。

では、また(^^)/