エクセルＶＢＡで引き数に指定した範囲を高速に検索

質問

いつもお世話になります。
エクセル（２００３）で指定したデータと同じデータを指定範囲から探し、その行数を返す関数を作りたいのですが、何か良い方法を教えていただけませんでしょうか。
正順で調べて返すことはできるようになったのですが、５０００行に貼り付けると実用的な速度が出なくて、、。実際には１００００行以上になりそうです。せめて逆順に検索してループを抜けるか、とも思うのですが、それどころではない方法でもあるとうれしいです。

ちなみに、現在書いてあるコードは以下の通りです。

Function LasteData(tg As Object, ar As Range) As Integer ' -------
'
' ar の中にある tgと同じデータの最後の位置を、その行番号で返す。
' 見つからない時は、0 を返す。
'
' ---------------------------------------------------------------
Dim r As Range, p As Integer

p = 0

For Each r In ar
If Not IsEmpty(r.Value) Then
If r.Value = tg.Value Then
p = r.Row
End If
End If
Next r

LastData = p

End Function

回答No.4

end-u · ベストアンサー

Findメソッドのヘルプを参照してください。
引数SearchDirectionをxlPreviousで使うとReverseFind的です。

Function LastData(tg As Range, ar As Range) As Long
　　Dim r As Range
　　Dim p As Long

　　Set r = ar.Find(What:=tg.Value, _
　　　　　　　　　　LookIn:=xlValues, _
　　　　　　　　　　LookAt:=xlWhole, _
　　　　　　　　　　SearchOrder:=xlByRows, _
　　　　　　　　　　SearchDirection:=xlPrevious, _
　　　　　　　　　　MatchByte:=True)
　　If Not r Is Nothing Then
　　　　p = r.Row
　　　　Set r = Nothing
　　End If
　　LastData = p
End Function

お礼

FindRiverseが可能である事に気がつきませんでした。
先ほど使ってみたところ、かろうじて許容範囲内におさまりそうなので、この方法で行ってみるつもりです。ありがとうございました。

回答No.5

end-u

>５０００行に貼り付けると実用的な速度が出なくて、、。実際には１００００行以上になりそうです。
ワークシートで使うユーザー定義関数を作りたいという事でしたか。
読み違えてました。すみません。orz

例えば検索範囲が数万件で、数式として貼り付ける範囲が10,000件程になるなら
Findを使うのは実用的ではありません。
No.3のki-aaaさんのdictionaryオブジェクトを使った手法をお勧めします。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_dictionary.html

または、ワークシートユーザー定義関数で処理する量では無いように思います。
素直にSubプロシージャで処理したほうが良くないですか？

Sub test()
　　Dim dic　As Object
　　Dim r(2) As Range
　　Dim ri　 As Range
　　Dim mx　 As Long
　　Dim i　　As Long
　　Dim v, w

　　On Error Resume Next
　　With Application
　　　　Set r(0) = .InputBox("検索対象範囲（ar）を選択してください。", Type:=8)
　　　　Set r(1) = .InputBox("検索値の範囲（tg）を選択してください。", Type:=8)
　　　　Set r(2) = .InputBox("結果を書き出す先頭セルを選択してください。", Type:=8)
　　End With
　　If Err.Number <> 0 Then
　　　　MsgBox "cancel"
　　　　Exit Sub
　　End If
　　On Error GoTo 0

　　Set dic = CreateObject("scripting.dictionary")
　　For Each ri In Intersect(r(0).Worksheet.UsedRange, r(0))
　　　　dic(ri.Value) = ri.Row
　　Next
　　v = r(1).Value
　　mx = UBound(v)
　　ReDim w(1 To mx, 0) As Long
　　For i = 1 To mx
　　　　w(i, 0) = dic(v(i, 1))
　　Next
　　r(2).Resize(mx, 1).Value = w
　　Set dic = Nothing
　　Erase r, w
End Sub

お礼

早く締め切り過ぎたようで、失礼しました。ご回答ありがとうございます。
仕事で使い始めに間に合わせるためにとりあえずでFindを使っていますが、動いている間に配列系のコードを書いてみるつもりです。そのため、関数にして組んでいます。
何せ、もともとvba の素養もなく、参考書もなく、ネット上のコードを参考にしているだけなので、自分でも「だいじょうぶかな？」状態です。きっとまたわけがわからなくてお聞きする事が出てくると思いますので、その時はまたお願いします。

回答No.3

ki-aaa

こんにちわ、

まず前提として、検索範囲(ar)が一定とします。

この回答例では、sheet1のA列です。

標準モジュール
Option Explicit

Public myDic As Object 'Scripting.Dictionary

Private Sub myDec_set()
Dim i As Long
Dim v As Variant

With Sheets("Sheet1")
v = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Value
End With
Set myDic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(v)
myDic(v(i, 1)) = i
Next i
Erase v
End Sub

Function LastData(tg As Object) As Long
If myDic Is Nothing Then
Call myDec_set
End If
LastData = myDic.Item(tg.Value)
End Function

Sub Auto_Close()
Set myDic = Nothing
End Sub

お礼

配列に取り込む例ですね。先の方とともに、大切なコード列として勉強させていただきます。ありがとうございました。

回答No.2

mitarashi

指定範囲のサイズが大きい場合は、Rangeオブジェクトを操作せず、一旦配列に受けて操作する事で速度アップが図れます。
下記コードで、APIを使用しているのは時間を測定するためだけですので、気になさらない様に。
当方の、PentiumM,1.3G Hz,xl2000の環境で、
Rangeオブジェクトを扱う場合、200msec強、
配列に受けて扱う場合8～3msecといった速度差があります。
下記コードでは、実験用にとにかく10000回ループを回しておりますが、実際にはFor i = 1 To maxRowのところを、For i = maxRow to 1 step -1にして、見つかったらExit forすれば、更に時間短縮が図れると思います。ご参考まで。

Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Private Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub test()
Dim i As Long, startTime As Long
Dim rng As Range, myCell As Range
Dim buf As Variant
Const maxRow As Long = 10000

timeBeginPeriod 1
Sleep 100 'タイマー安定待ち
Set rng = Range(Cells(1, 1), Cells(maxRow, 1))
buf = rng
'Rangeオブジェクトにアクセスする場合
startTime = timeGetTime
For Each myCell In rng.Cells
If myCell.Value = "test" Then
End If
Next myCell
Debug.Print timeGetTime - startTime
'Rangeの内容を代入した配列をアクセスする場合
startTime = timeGetTime
For i = 1 To maxRow
If buf(i, 1) = "test" Then
End If
Next i
Debug.Print timeGetTime - startTime
timeEndPeriod 1
End Sub

お礼

一度配列に取り込むというのも調べているうちに見ていたのですが、よく解からず放っておりました。
このくらい効果があるのでしたら試す価値ありですね。試してみます。
ありがとうございました。

回答No.1

imogasi

実行速度の速い襲いを、使用ロジックから、云々するほど、小生には力はない。普通のレベルではそうだろうと思う。
しかし全セル総なめ法は一般には、速くない。
Ｆｉｎｄメソッドを使って試してみてはどうでしょう。
どういうコードになるかは、簡単な適当行数のデータを良いし、マクロの記録で、編集ー検索ーで１セル見つかっても、検索を続け、最初の該当に帰るまで操作をして、コードを見たり、ＷＥＢで「エクセルＶＢＡ　Ｆｉｎｄ」で照会すれば、コードは作れるだろう。
ちなみにＲｅｖｅｒｓｅＦｉｎｄ的なものはＶＢＡには無いようだ。
昇順云々に拘っても２分法などが使えないと、検索に意味が無い。
意外に、ソートして、２分法などで検索したら早いかもしれないが、データ列が複数のようだし、セルの順序を壊すとダメなのだろう。
また、同様質問で
http://okwave.jp/qa/q4704609.html
ＳｃｒｅｅｎＵｐｄａｔｉｎｇの問題で満足している例ケースもある。
ーー
参考 A1:D5でbを探す例。その見つかったセルの内最下行数
Sub test1()
Set 範囲 = Range("A1:D5")
検索情報 = "b"
Set 変数 = 範囲.Find(検索情報, LookIn:=xlValues)
If Not 変数 Is Nothing Then
変数2 = 変数.Address
Do
MsgBox 変数.Address
Set 変数 = 範囲.FindNext(変数)
If Not 変数 Is Nothing Then
m = IIf(m < 変数.Row, 変数.Row, m)
End If
Loop While Not 変数 Is Nothing And 変数.Address <> 変数2

MsgBox m

End If
End Sub
多数行で速くなるかどうか、やってみてください。

お礼

早速の回答ありがとうございます。
ＤＯＳの時代にPascal系の言語でさんざプログラムを書いていた身としては、vbaの融通の効き加減にめんくらっております。
もとのデータが数値なので、使い難いと感じて避けていました。
ちょっと勉強して、トライしてみます。