Excelで取引先表を作ってみよう

Private Sub Workbook_Open()
    bDataChangeFlag = False
    
    RecordCount = GetRecordCout
    Sheets("メイン").Range("E3") = "( /" & RecordCount & " )"
    Sheets("メイン").Range("E3").Font.Color = vbBlack
End Sub

'取引先IDが登録されているかチェック
Private Function ExCopyToSheetCheck(id As Long, ByRef srow As String) As Boolean
    Dim lrow As Long
    Dim tRange As Range
    Dim s As String
    
    srow = ""
    ExCopyToSheetCheck = False
    s = ""
    
    lrow = Sheets("抽出").Range("A65536").End(xlUp).Row
        
    If lrow = 4 Then
        srow = "A5"
    Else
        Set tRange = Sheets("抽出"). _
            Range("A5", Sheets("抽出").Range("A5").Offset(rowOffset:=lrow)). _
            Find(What:=id, LookIn:=xlValues) '
        If Not tRange Is Nothing Then
            srow = tRange.Address
            ExCopyToSheetCheck = True
        Else
            srow = "A" & lrow + 1
        End If
    End If
End Function

'抽出からコピー
Private Sub ExDataDisp(srow As String)
    Dim i As Integer
    Dim scell As String
    
    'IDコピー
    TextBox14 = Sheets("抽出").Range(srow)
    '前、次ボタン用のセル位置
    Sheets("抽出").Range("CR5") = "<=" & TextBox14
    Sheets("抽出").Range("CR6") = ">=" & TextBox14
    
    TextBox15 = Sheets("抽出").Range(srow).Offset(0, 1)
    TextBox16 = Sheets("抽出").Range(srow).Offset(0, 2)
    TextBox17 = Sheets("抽出").Range(srow).Offset(0, 3)
    TextBox18 = Sheets("抽出").Range(srow).Offset(0, 4)
    TextBox19 = Sheets("抽出").Range(srow).Offset(0, 5)
    TextBox20 = Sheets("抽出").Range(srow).Offset(0, 6)
    TextBox21 = Sheets("抽出").Range(srow).Offset(0, 7)
    TextBox22 = Sheets("抽出").Range(srow).Offset(0, 8)
    TextBox23 = Sheets("抽出").Range(srow).Offset(0, 9)
    TextBox24 = Sheets("抽出").Range(srow).Offset(0, 10)
    TextBox25 = Sheets("抽出").Range(srow).Offset(0, 11)
End Sub

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

'指定範囲から最小値を検索
Private Function ExFindMin(ByRef srow As String) As Boolean
    Dim ans As Long
    Dim tRange As Range
    
    ExFindMin = 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)
        ExFindMin = True
    End If
End Function

'先頭のレコード
Private Sub CommandButton3_Click()
    Dim sr As String
    
    If ExFindMin(sr) Then
        ExDataDisp sr
    Else
        Beep
    End If
End Sub

'前のレコード
Private Sub CommandButton4_Click()
    Dim sr As String
    
    If IsNumeric(Sheets("抽出").Range("CT6")) Then
        ExCopyToSheetCheck Sheets("抽出").Range("CT6"), sr
        ExDataDisp sr
    Else
        Beep
    End If
End Sub

'次のレコード
Private Sub CommandButton5_Click()
    Dim sr As String
    
    If IsNumeric(Sheets("抽出").Range("CT5")) Then
        ExCopyToSheetCheck Sheets("抽出").Range("CT5"), sr
        ExDataDisp sr
    Else
        Beep
    End If
End Sub

'最終レコード
Private Sub CommandButton6_Click()
    Dim sr As String
    
    If ExFindMax(sr) Then
        ExDataDisp sr
    Else
        Beep
    End If
End Sub

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

Private Sub ExEnabled(bsw As Boolean)
    Dim lcol As Long
    
    If bsw = False Then
        TextBox14 = ""
        TextBox15 = ""
        TextBox16 = ""
        TextBox17 = ""
        TextBox18 = ""
        TextBox19 = ""
        TextBox20 = ""
        TextBox21 = ""
        TextBox22 = ""
        TextBox23 = ""
        TextBox24 = ""
        TextBox25 = ""
    End If
    
    Frame1.Enabled = bsw
    If bsw Then
        lcol = 15789806
    Else
        lcol = 12038063
    End If
    TextBox14.BackColor = lcol
    TextBox15.BackColor = lcol
    TextBox16.BackColor = lcol
    TextBox17.BackColor = lcol
    TextBox18.BackColor = lcol
    TextBox19.BackColor = lcol
    TextBox20.BackColor = lcol
    TextBox21.BackColor = lcol
    TextBox22.BackColor = lcol
    TextBox23.BackColor = lcol
    TextBox24.BackColor = lcol
    TextBox25.BackColor = lcol
    CommandButton3.Enabled = bsw
    CommandButton4.Enabled = bsw
    CommandButton5.Enabled = bsw
    CommandButton6.Enabled = bsw
    CommandButton7.Enabled = bsw
End Sub

Private Function ExFillterInputCheck() As Boolean
    Dim bflag As Boolean
    Dim last As Long
    
    '条件のクリア
    Range("Z5:AL5") = ""
    last = Sheets("抽出").Range("A65536").End(xlUp).Row
    If last > 4 Then
        Sheets("抽出").Range("A5:L" & last) = ""
    End If
    
    bflag = False
    'ID MIN
    If TextBox1 <> "" Then
        If IsNumeric(TextBox1) Then
            bflag = True
            Range("Z5") = ">=" & TextBox1
        End If
    End If
    'ID MAX
    If TextBox2 <> "" Then
        If IsNumeric(TextBox2) Then
            bflag = True
            Range("AA5") = "<=" & TextBox2
        End If
    End If
    '会社名
    If TextBox3 <> "" Then
        bflag = True
        Range("AB5") = "*" & TextBox3 & "*"
    End If
    '担当者名
    If TextBox4 <> "" Then
        bflag = True
        Range("AC5") = "*" & TextBox4 & "*"
    End If
    '〒
    If TextBox5 <> "" Then
        bflag = True
        Range("AD5") = "*" & TextBox5 & "*"
    End If
    '住所
    If TextBox6 <> "" Then
        bflag = True
        Range("AE5") = "*" & TextBox6 & "*"
    End If
    '電話番号
    If TextBox7 <> "" Then
        bflag = True
        Range("AF5") = "*" & TextBox7 & "*"
    End If
    '携帯
    If TextBox8 <> "" Then
        bflag = True
        Range("AG5") = "*" & TextBox8 & "*"
    End If
    'FAX番号
    If TextBox9 <> "" Then
        bflag = True
        Range("AH5") = "*" & TextBox9 & "*"
    End If
    'メール
    If TextBox10 <> "" Then
        bflag = True
        Range("AI5") = "*" & TextBox10 & "*"
    End If
    '支払い
    If TextBox11 <> "" Then
        bflag = True
        Range("AJ5") = "*" & TextBox11 & "*"
    End If
    '口座番号
    If TextBox12 <> "" Then
        bflag = True
        Range("AK5") = "*" & TextBox12 & "*"
    End If
    '備考
    If TextBox13 <> "" Then
        bflag = True
        Range("AL5") = "*" & TextBox13 & "*"
    End If

    If bflag Then
        last = Sheets("T取引先").Range("A65536").End(xlUp).Row
        Sheets("T取引先").Range("A4:L" & last).AdvancedFilter Action:=xlFilterCopy, _
            Criteriarange:=Range("Z4:AL5"), copytorange:=Sheets("抽出").Range("A4:L4"), unique:=False
        last = Sheets("抽出").Range("A65536").End(xlUp).Row
        If last = 4 Then
            ExEnabled False
            Label14.Caption = "見つかりませんでした。"
        Else
            ExEnabled True
            ExDataDisp "A" & last
            Label14.Caption = last - 4 & " 件見つかりました。"
        End If
        Label14.Visible = True
    End If
End Function