【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ループを回さず、ラベルを付けて＋１ずつ処理していくところを工夫してみました。
備忘録、備忘録。
では、また(^^)/
【自作ソフト】運動会個人走コース編成シート（男女交互組）
疾走タイム順に、３クラスを6人ずつ、男女交互組で組編成ができます。
ネットを探しても案外なかったので作ってみました。
もしかして、数式で作るのが普通なのかもしれませんが、
私はリンクを貼りまくったり、セルを押したら長い数式が出てくるのはあまり好きじゃないのでマクロで作ってみました。
速い順、遅い順を選択してボタンを押すと、
男子を並び替えます。元に戻すこともできます。
同じように、女子も並び替えて自動でコースに入れます。
男女交互に組編成します。
男女シートのボタンを押し忘れても、最終的な編成はこのシートでできます。
男女シートでの並び替えの条件だけは、正しく設定しておいてください。
サンプルファイル（男女別にも組めるように改良しています。）
↓
今年は、運動会やらない学校もあるんでしょうね。
では、また(^^)/
