| |
こんな方法も有るよ
探索範囲、探索値、結果を配列に取っているので余り大きな物は無理が有るかも?
以下を同一の標準モジュールに記述して下さい
Public Sub Test()
Dim i As Long
Dim vntData As Variant
Dim vntItem As Variant
Dim vntResult As Variant
'Sheet2のデータを探索範囲用配列に取得
With Worksheets("Sheet2")
vntData = Range(.Cells(2, 1), _
.Cells(65536, 2).End(xlUp)).Value
End With
With Worksheets("Sheet1")
'Sheet1の探索値を配列に取得
vntItem = Range(.Cells(2, 1), _
.Cells(65536, 1).End(xlUp)).Value
'結果用の配列を確保
ReDim vntResult(1 To UBound(vntItem, 1), 1 To 1)
'Sheet1の探索値を探索範囲より二進探索し、
'結果用配列に結果を代入
For i = 1 To UBound(vntItem, 1)
vntResult(i, 1) = RowSearch(vntItem(i, 1), vntData)
Next i
'結果用配列を出力
.Range("B2").Resize(UBound(vntItem, 1)).Value = vntResult
End With
End Sub
Private Function RowSearch(vntKey As Variant, _
vntScope As Variant) As String
Dim lngLow As Long
Dim lngHigh As Long
Dim lngMiddle As Long
lngLow = LBound(vntScope, 1)
lngHigh = UBound(vntScope, 1)
Do While lngLow <= lngHigh
lngMiddle = (lngLow + lngHigh) \ 2
Select Case vntScope(lngMiddle, 1)
Case Is < vntKey
lngLow = lngMiddle + 1
Case Is > vntKey
lngHigh = lngMiddle - 1
Case Is = vntKey
lngLow = lngMiddle + 1
lngHigh = lngMiddle - 1
End Select
Loop
If lngLow = lngHigh + 2 Then
RowSearch = vntScope(lngMiddle, 2)
Else
RowSearch = ""
End If
End Function
|
|
- 03/8/23(土) 5:46 -
