Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

55864 / 76732

←次へ　｜　前へ→


	【25634】Re:データ検索について

ちゃっぴ - 05/6/9(木) 0:08 -


	引用なし

	パスワード

Sample です。

Const END_ROW As Long = 1000&

' これを実行
Sub Main()
　　Dim i As Long
　　
　　For i = 1 To 5
　　　　Debug.Print F_CallTest("test" & i)
　　Next
End Sub

' Test呼び出し
Function F_CallTest(strProcedure As String) As String
　　Dim curTime As Currency
　　Dim i　　　 As Long
　　
　　curTime = Timer
　　For i = 1 To END_ROW
　　　　Application.Run strProcedure, Cells(i, 1)
　　Next
　　
　　F_CallTest = strProcedure & vbTab & CCur(Timer) - curTime
End Function

' Data作成
Sub SetData()
　　Dim lngData()　 As Long
　　Dim i　　　　　 As Long

　　ReDim lngData(1 To END_ROW, 1 To 1)
　　
　　For i = 1 To END_ROW
　　　　lngData(i, 1) = "hogehoge" & i
　　Next
　　
　　Cells(1, 1).Resize(END_ROW).Value = lngData
End Sub

' For ～ Next Loop 順次検索
Sub test1(rngTarget As Excel.Range)
　　Dim strTarget　 As String
　　Dim i　　　　　 As Long
　　
　　strTarget = rngTarget.Value
　　
　　For i = 1 To END_ROW
　　　　If Cells(i, 1).Value = strTarget Then Exit For
　　Next
End Sub

' For Each ～ Next Loop 順次検索
Sub test2(rngTarget As Excel.Range)
　　Dim objTarget　 As Excel.Range
　　Dim strTarget　 As String
　　Dim i　　　　　 As Long
　　
　　strTarget = rngTarget.Value
　　
　　For Each objTarget In Cells(1, 1).Resize(END_ROW)
　　　　If objTarget.Value = strTarget Then Exit For
　　Next
End Sub

' 配列順次検索
Sub test3(rngTarget As Excel.Range)
　　Dim strTarget　 As String
　　Dim vntData　　 As Variant
　　Dim vntbuf　　　As Variant
　　Dim strBuf　　　As String
　　Dim i　　　　　 As Long
　　
　　vntData = Cells(1, 1).Resize(END_ROW).Value
　　strTarget = rngTarget.Value
　　
　　For Each vntbuf In vntData
　　　　If vntbuf = strTarget Then Exit For
　　Next
End Sub

' Find Method 順次検索
Sub test4(rngTarget As Excel.Range)
　　Dim strTarget　 As String
　　Dim rngResult　 As Excel.Range
　　
　　strTarget = rngTarget.Value
　　With Cells
　　　　Set rngResult = .Item(1).Resize(END_ROW).Find( _
　　　　　　What:=strTarget, After:=.Item(1), LookIn:=xlFormulas, _
　　　　　　LookAt:=xlWhole, SearchOrder:=xlByRows, _
　　　　　　SearchDirection:=xlNext, MatchCase:=True)
　　End With
End Sub

' Match 2分探索
Sub test5(rngTarget As Excel.Range)
　　Dim vntResult As Variant
　　
　　vntResult = Application.Match( _
　　　　rngTarget, Cells(1, 1).Resize(END_ROW), 1)
End Sub

0 hits

▼

【25611】データ検索について えくせーる 05/6/8(水) 9:52