Excel2007で顧客管理ソフトを作ってみよう

Option Explicit

'指定範囲から最小値を検索
Private Function ExFindMinRange(ByRef srow As String) As Boolean
    Dim ans As Long
    Dim tRange As Range
    
    ExFindMinRange = False
    '1列目の最小値を捜す
    Set tRange = Sheets("検索").Columns(1)
    ans = Application.WorksheetFunction.Min(tRange)
    
    '最小値のセルを取得
    Set tRange = tRange.Find(What:=ans, LookIn:=xlValues, LookAt:=xlWhole)
    If Not tRange Is Nothing Then
        srow = tRange.Address(RowAbsolute:=False, ColumnAbsolute:=False)
        ExFindMinRange = True
    End If
End Function

'一覧から入力部にデータコピー
Private Sub ExDataDisp(srow As String)
    Range("E3") = Sheets("検索").Range(srow)
    
    '前、次ボタン用のセル位置
    Sheets("検索").Range("CR5") = "<=" & Range("E3")
    Sheets("検索").Range("CR6") = ">=" & Range("E3")

    Range("C5") = Sheets("検索").Range(srow).Offset(0, 1)
    Range("C6") = Sheets("検索").Range(srow).Offset(0, 2)
    Range("C7") = Sheets("検索").Range(srow).Offset(0, 3)
    Range("C8") = Sheets("検索").Range(srow).Offset(0, 4)
    Range("C9") = Sheets("検索").Range(srow).Offset(0, 5)
    
    Range("F5") = Sheets("検索").Range(srow).Offset(0, 6)
    Range("F6") = Sheets("検索").Range(srow).Offset(0, 7)
    Range("F7") = Sheets("検索").Range(srow).Offset(0, 8)
    Range("F8") = Sheets("検索").Range(srow).Offset(0, 9)
    Range("F9") = Sheets("検索").Range(srow).Offset(0, 10)
    
    bDataChangeFlag = False
End Sub

下記のVBAコードに変更してください。

Private Sub CommandButton1_Click()
    Dim tRange As Range
    Dim lrow As Long
    Dim s1 As String
    Dim bFlag As Boolean
    Dim sr As String
    
    If TextBox1 <> "" And Not IsNumeric(TextBox1) Then
        MsgBox "顧客IDには数値を入力してください。"
        TextBox1.SetFocus
        Exit Sub
    End If

    bFlag = False
    If TextBox1 <> "" Then
        Worksheets("一覧").Range("A2").AutoFilter field:=1, Criteria1:=TextBox1
        bFlag = True
    End If
    
    If TextBox2 <> "" Then
        Worksheets("一覧").Range("A2").AutoFilter field:=3, Criteria1:="*" & TextBox2 & "*"
        bFlag = True
    End If
    
    If bFlag = False Then
        MsgBox "検索内容を入力してください。"
        TextBox1.SetFocus
        Exit Sub
    End If
        
    Sheets("検索").Cells.Clear

    '最終行を捜す
    lrow = Sheets("一覧").Range("A1048576").End(xlUp).Row - 1 '
    If lrow = 0 Then
        Label2.Visible = True
        Label3.Visible = False
        ExInputClear
    Else
        Label3.Visible = True
        Label2.Visible = False
        s1 = "A1:K" & lrow + 1
        Sheets("一覧").Range(s1).Copy
        Sheets("検索").Range("A1").PasteSpecial
    
        If ExFindMinRange(sr) Then
            ExDataDisp sr
        Else
            Beep
        End If
    End If
    Worksheets("一覧").AutoFilterMode = False
End Sub