'セル値の検索によりフィルタをするサンプルマクロ(Excel95)

'データ範囲は1行目が項目見出しであるという前提です。
'検索値とセル値のデータ型が一致しているという前提です。
'フィルタ前にデータを昇順に並べ替えます（大文字小文字を区別します。）

'以下のコードをモジュールにコピーしてTestマクロを実行してください。
'A列が200から300、B列が"C"から"D"までのセル範囲を選択します。

Option Explicit
Option Compare Binary

Sub Test()

    'テスト用ブックを作成
    Application.ScreenUpdating = False
    Workbooks.Add xlWorksheet
    With ActiveSheet
        .Cells.Clear
        .Range("A1:B1").Value = Array("数値", "文字列")
        .Range("A2").Value = 1
        .Range("A2").DataSeries Rowcol:=xlColumns, Stop:=500
        .Range("B2").Value = "A001"
        .Range("B3").Value = "B002"
        .Range("B4").Value = "C003"
        .Range("B5").Value = "D004"
        .Range("B6").Value = "E005"
        .Range("B2:B6").Copy Range("B7:B501")
    End With
    Application.ScreenUpdating = True

    'フィルタのテスト実行
    MyFilterTest
End Sub

'フィルタのテスト実行マクロ
Sub MyFilterTest()
    Dim range1 As Range, range2 As Range, range3 As Range

    'データ範囲の設定
    Set range1 = ActiveSheet.Cells(1, 1).CurrentRegion
    If range1.Rows.Count = 1 Then
        MsgBox "データがありません。", vbExclamation
        Exit Sub
    End If

    '見出し行を除くデータ範囲を取得
    Set range1 = range1.Resize(range1.Rows.Count - 1).Offset(1)

    'B列が"C"から"D"までのセル範囲を取得します。
    range1.SortSpecial SortMethod:=xlSyllabary, _
        Key1:=range1.Cells(1, 2), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, _
        MatchCase:=True, Orientation:=xlTopToBottom
    Set range2 = MyFilterString(range1, 2, "C", "D" & Chr$(255))
    If range2 Is Nothing Then
        MsgBox "該当するデータはありません。", vbExclamation
        Exit Sub
    End If
    range2.Select

    'A列が100から200までのセル範囲を取得します。
    range2.SortSpecial SortMethod:=xlSyllabary, _
        Key1:=range2.Cells(1, 1), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, _
        MatchCase:=True, Orientation:=xlTopToBottom
    Set range3 = MyFilterNumber(range2, 1, CDbl(200), CDbl(300))
    If range3 Is Nothing Then
        MsgBox "該当するデータはありません。", vbExclamation
        Exit Sub
    End If
    range3.Select

End Sub


'数値データをフィルタする関数

'並べ替え済みであることを前提とします。
'セル値はすべて数値型であることを前提とします。

Function MyFilterNumber(range1 As Range, iIndex As Integer, _
        dfStart As Double, dfEnd As Double) As Range
    Dim iStart As Long, iEnd As Long
    iStart = SearchStart(dfStart, range1.Columns(iIndex))
    iEnd = SearchEnd(dfEnd, range1.Columns(iIndex))
    If iEnd >= iStart Then
        Set MyFilterNumber = range1.Rows(iStart).Resize(iEnd - iStart + 1)
    Else
        Set MyFilterNumber = Nothing
    End If
End Function


'文字列データをフィルタする関数

'並べ替え済みであることを前提とします。
'セル値はすべて文字列型であることを前提とします。

Function MyFilterString(range1 As Range, iIndex As Integer, _
        sStart As String, sEnd As String) As Range
    Dim iStart As Long, iEnd As Long
    iStart = SearchStart(sStart, range1.Columns(iIndex))
    iEnd = SearchEnd(sEnd, range1.Columns(iIndex))
    If iEnd >= iStart Then
        Set MyFilterString = range1.Rows(iStart).Resize(iEnd - iStart + 1)
    Else
        Set MyFilterString = Nothing
    End If
End Function


'検索値の先頭行番号を返す関数

'並べ替え済みであることを前提とします。
'検索値とセル値のデータ型が一致していることを前提とします。

Function SearchStart(vValue As Variant, range1 As Range) As Long
    Dim iLeft As Long, iRight As Long, iMid As Long
    iLeft = 1
    iRight = range1.Rows.Count
    Do While iLeft <= iRight

        '真ん中のインデックスを取得する
        iMid = (iLeft + iRight) \ 2

        If vValue <= range1.Cells(iMid, 1).Value Then

            '検索値以上の場合
            iRight = iMid - 1
        Else

           '検索値より小さい場合
            iLeft = iMid + 1
        End If
    Loop
    SearchStart = iLeft
End Function


'検索値の最終行番号を返す関数

'ソート済みであることを前提とします。
'検索値とセル値のデータ型が一致していることを前提とします。

Function SearchEnd(vValue As Variant, range1 As Range) As Long
    Dim iLeft As Long, iRight As Long, iMid As Long

    iLeft = 1
    iRight = range1.Rows.Count

    Do While iLeft <= iRight

        '真ん中のインデックスを取得する
        iMid = (iLeft + iRight) \ 2

        If vValue < range1.Cells(iMid, 1).Value Then

            '検索値より大きい場合
            iRight = iMid - 1
        Else

           '検索値以下の場合
            iLeft = iMid + 1
        End If
    Loop
    SearchEnd = iRight
End Function