[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『EXCEL VBA Findで逆方向に検索』（たちお）Excel2003,WindowsXP
sheet1のA列に"■"がランダムに入力されています（"■"以外の値も混在）。 A列の任意のセルをアクティブにした状態から、 上下方向に次の"■"を検索したいです。 下方向に検索する場合は下記コードで検索できましたが、 上方向に検索する場合はどの様にコードを改修すれば良いのでしょうか？ ご教授お願い致します。
尚、FindではなくDo〜Loop Untilで、 セル値を"■"にヒットするまで1個づつ検索していく方法であれば、 上方向の検索もできたのですが、出来ればFindで実現したいです。 (処理時間が短くなる（？）と思うので…)
Sub 次の■へジャンプ()
Dim nowcell_add As String '現在のアドレス Dim nowcell_row As Integer '現在の行 Dim nowcell_col As Integer '現在の列
Dim nextbox As Variant '次の■のセル Dim nextbox_add As String '次の■のアドレス
Dim last_row As Integer '最終行
nowcell_add = ActiveCell.Address nowcell_row = ActiveCell.Row nowcell_col = ActiveCell.Column last_row = Cells(Rows.Count, 1).End(xlUp).Row
If (nowcell_row < last_row) And (nowcell_col = 1) Then
Set nextbox = Range(Cells(nowcell_row, 1), Cells(last_row, 1)).Find("■")
If Not nextbox Is Nothing Then
nextbox_add = nextbox.Address
Range(nextbox_add).Select
End If
End If
End Sub
私は、Findメソッド扱いが面倒なので、これをラップしたプロシジャーを先に作ってしまっています。
新規ブックにて試してみてください。
まず、コードから、標準モジュール(module1)にサンプルデータ作成プロシジャー
'============================================================================
Option Explicit
Sub mk_sample()
With Range("a1:a100")
.Formula = "=int(rand()*10)"
.Value = .Value
End With
End Sub
別の標準モジュール(Module2)に上下検索プロシジャー
'==================================================================
Sub main()
Const 検索値 = 1
Dim ans As Long
Dim strng As Range
Dim rng As Range
With Range("a1:a100")
ans = MsgBox("検索方向 はい →下 いいえ→上", vbYesNo)
If ans = 6 Then
Set strng = get_strng(ActiveCell, .Cells, xlNext)
If strng Is Nothing Then
MsgBox "検索位置が不正です"
Exit Sub
Else
Set rng = get_findcell(検索値, .Cells, strng, xlValues, xlWhole, xlByColumns, xlNext)
End If
Else
Set strng = get_strng(ActiveCell, .Cells, xlPrevious)
If strng Is Nothing Then
MsgBox "検索位置が不正です"
Exit Sub
Else
Set rng = get_findcell(検索値, .Cells, strng, xlValues, xlWhole, xlByColumns, xlPrevious)
End If
End If
Do Until rng Is Nothing
rng.Select
MsgBox "ok"
Set rng = get_findcell
Loop
End With
End Sub
'=======================================================================================
Function get_strng(chkrng As Range, f_rng As Range, Optional ByVal asd As XlSearchDirection = 1) As Range
'検索開始位置をチェックする
On Error Resume Next
Set get_strng = Nothing
If Not Application.Intersect(chkrng, f_rng) Is Nothing Then
If asd = xlNext Then
If chkrng.Row = f_rng.Cells(1, 1).Row Then
Set get_strng = f_rng.Cells(f_rng.Rows.Count, f_rng.Columns.Count)
Else
Set get_strng = chkrng.Offset(-1, 0)
End If
Else
If chkrng.Row = f_rng.Cells(f_rng.Rows.Count, f_rng.Columns.Count).Row Then
Set get_strng = f_rng.Cells(1, 1)
Else
Set get_strng = chkrng.Offset(1, 0)
End If
End If
End If
End Function
又、別の標準モジュール(Module3)にFindメソッド汎用プロシジャー
'================================================================================
Function get_findcell(Optional ByVal f_v As Variant = "", _
Optional ByVal rng As Range = Nothing, _
Optional ByVal strng As Range = Nothing, _
Optional ByVal alookin As XlFindLookIn = -4163, _
Optional ByVal alookat As XlLookAt = 1, _
Optional ByVal aso As XlSearchOrder = 1, _
Optional ByVal asd As XlSearchDirection = 1, _
Optional ByVal mc As Boolean = False, _
Optional ByVal mb As Boolean = True) As Range
'指定された値でセル範囲を検索し､該当するセルを取得する
'input : f_v 検索する値
' rng 検索する範囲
' strng 検索開始するセル（実際には、このセルの次から検索する）
' alookin 検索対象 xlvalues,xlformulas,xlcomments
' alookat: :検索方法 1-完全一致 2-部分一致
' aso : 検索順序 1 行 2 列
' asd : 検索方向 1 Xlnext 2 XlPrevious
' mc : 大文字・小文字の区別 False しない True する
' mb : 半角と全角を区別 True する False しない
'output:get_findcell 見つかったセル(見つからなかったときはNothingが返る)
Static 検索範囲 As Range
Static 最初に見つかったセル As Range
Static 直前に見つかったセル As Range
Static 検索方向 As XlSearchDirection
If Not rng Is Nothing Then
Set 検索範囲 = rng
If strng Is Nothing Then
If asd = 1 Then
Set strng = 検索範囲.Cells(検索範囲.Rows.Count, 検索範囲.Columns.Count)
Else
Set strng = 検索範囲.Cells(1, 1)
End If
End If
End If
If f_v <> "" Then
Set get_findcell = 検索範囲.Find(f_v, strng, alookin, alookat, aso, asd, mc, mb)
If Not get_findcell Is Nothing Then
Set 最初に見つかったセル = get_findcell
Set 直前に見つかったセル = get_findcell
検索方向 = asd
End If
Else
If 検索方向 = xlNext Then
Set get_findcell = 検索範囲.FindNext(直前に見つかったセル)
Else
Set get_findcell = 検索範囲.FindPrevious(直前に見つかったセル)
End If
If get_findcell.Address = 最初に見つかったセル.Address Then
Set get_findcell = Nothing
Else
Set 直前に見つかったセル = get_findcell
End If
End If
End Function
使用方法
まず、mk_sampleを実行してみてください。 セル範囲A1:A100に0〜9の値がランダムに設定されます。 mainプログラムは、この中の1を検索する機能を持ちます。
A1:A100のセル範囲の中の適当なセルを選択した状態でプロシジャーmainを実行してください。
「検索方向 はい →下 いいえ→上」というメッセージが表示されます。
はい を選択すれば、選択したセルから下に1のあるセルを順次選択します。
いいえ を選択すれば、選択したセルから上に1のあるセルを順次選択します。
作動することを確認されたら、検索セル範囲や検索文字を変更して試してみてください。
もっとも、検索速度だけを重視すれば、Findメソッド以外の方法に目を向けるのも 良いかもしれませんよ！！
ichinose
>ichinose殿 早速のご解答有難う御座います。 ご提案頂いたプログラムの動作確認させて頂きました。 自分はまだまだ知識不足の為、 構文を読み下すには時間がかかりそうなので、 取り急ぎお礼まで。 因みに、 「検索速度だけを重視すれば、Findメソッド以外の方法…」とは、 例えばどんなモノがあるのでしょうか？
（たちお）
>因みに、 >「検索速度だけを重視すれば、Findメソッド以外の方法…」とは、 >例えばどんなモノがあるのでしょうか？ ＶＢＡと数式を使って検索値を探す方法なんて考えられます。
検討してみてください。
ichinose
すでに解決されたようですが、
逆方向の検索は、Find に SearchDirection:=xlPrevious を追加するだけです。 http://excelvba.pc-users.net/fol7/7_1.html
パフォーマンスに関してですが、EXCEL が用意している関数は、 同等のものをコードで書いたものに比べても高速である場合も あるようです。 http://officetanaka.net/excel/vba/speed/s9.htm (Mook)
たちおさんへ 休みになったので、数式を使った例です。
新規ブックにて試してみてください。
まず、コードから、標準モジュール(module1)にサンプルデータ作成プロシジャー これは、前回投稿と同じです。
'============================================================================
Option Explicit
Sub mk_sample()
With Range("a1:a100")
.Formula = "=int(rand()*10)"
.Value = .Value
End With
End Sub
別の標準モジュール(Module2)に上下検索プロシジャー
'==================================================================
Sub main()
Const 検索値 = 1
Dim g0 As Long
Dim ans As Long
Dim strng As Range
Dim myarray As Variant
Dim stind As Long
Dim edind As Long
Dim stepnum As Long
With Range("a1:a100")
If Not Application.Intersect(ActiveCell, .Cells) Is Nothing Then
ans = MsgBox("検索方向 はい →下 いいえ→上", vbYesNo)
If ans = 6 Then
Set strng = .Range(ActiveCell, .Cells(.Rows.Count))
Else
Set strng = .Range(.Cells(1), ActiveCell)
End If
With strng
MsgBox "transpose(if(" & .Address & "=" & 検索値 & _
",row(" & .Address & "),""" & Chr(&HFF) & """))" _
& vbCrLf & "こんな数式を評価します"
'↑これは、確認したら、コメント化してください
myarray = Evaluate("transpose(if(" & .Address & "=" & 検索値 & _
",row(" & .Address & "),""" & Chr(&HFF) & """))")
If Not IsArray(myarray) Then myarray = Array(myarray)
myarray = Filter(myarray, Chr(&HFF), False)
End With
Else
Exit Sub
End If
End With
If UBound(myarray) >= 0 Then
If ans = 6 Then
stind = LBound(myarray)
edind = UBound(myarray)
stepnum = 1
Else
stind = UBound(myarray)
edind = LBound(myarray)
stepnum = -1
End If
For g0 = stind To edind Step stepnum
Range("a" & myarray(g0)).Select
MsgBox "ok"
Next
End If
End Sub
使用方法
まず、mk_sampleを実行してみてください。 セル範囲A1:A100に0〜9の値がランダムに設定されます。 mainプログラムは、この中の1を検索する機能を持ちます。
A1:A100のセル範囲の中の適当なセルを選択した状態でプロシジャーmainを実行してください。
「検索方向 はい →下 いいえ→上」というメッセージが表示されます。
はい を選択すれば、選択したセルから下に1のあるセルを順次選択します。
いいえ を選択すれば、選択したセルから上に1のあるセルを順次選択します。
若干、仕様を変更しましたが、概ねFindと同じ動作をします。
Mookさんへ
> 逆方向の検索は、Find に >SearchDirection:=xlPrevious >を追加するだけです。
確かにオプションの設定はこれだけですが、 セル範囲から、Findメソッドを使って、複数の検索をする場合、 最初に見つかったセルを覚えておいて、次にそのセルが見つかったら検索終了 というロジックをコードにしなければなりません。 普段Findを使わない私には、これが面倒で・・・。
メインプロシジャーでは、Dir関数のような運用を
sub test()
dim flnm as variant
dim path as string
path="d:\xxxx\*.*"
flnm=dir(path)
do until flnm=""
msgbox flnm
flnm=dir
loop
end sub
Findメソッドでも行いたいと思っています。
Sub test()
Dim 検索値 As Variant
検索値 = 1
Dim rng As Range
Set rng = get_findcell(検索値, Range("a1:a100"), , , , , xlPrevious)
Do Until rng Is Nothing
rng.Select
MsgBox "ok"
Set rng = get_findcell
Loop
End Sub
>パフォーマンスに関してですが、EXCEL が用意している関数は、 >同等のものをコードで書いたものに比べても高速である場合も >あるようです。
これに関しては私も以前、別掲示板で何人かの方に御協力いただいて、
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=16648;id=excel
こんなことをしたことがありました。 Findは、フリガナまで検索するもんね（良い場合と悪い場合があります） 上位バージョンでは、これも選択できるようになっているのだろうか？
ichinose
色々とアドバイス有難う御座います。 ウ〜ム、 話が自分レベルには難しくなってきました… φ(*_*) 何処までを「VBA」「ﾜｰｸｼｰﾄ関数」で処理するか、 柔軟に考えるようにしてみます。
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.