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

Step 11 「抽出」コードの作成 その3 抽出数の表示

メニューに戻る

スポンサーリンク



標準モジュールコード

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

Option Explicit

Public bDataChangeFlag As Boolean
'抽出結果数を保持
Public FillterCount As Long
'登録済みレコード数の保持
Public RecordCount As Long

抽出フォームコード

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

Private Sub UserForm_Initialize()
    FillterCount = 0
End Sub

Private Function ExFillterInputCheck() As Boolean
    Dim bflag As Boolean
    Dim last As Long
    
    FillterCount = 0
    '条件のクリア
    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
            Label14.Caption = "見つかりませんでした。"
        Else
            Label14.Caption = last - 4 & " 件見つかりました。"
            FillterCount = last - 4
        End If
        Label14.Visible = True
    End If
End Function

スポンサーリンク



メインシートコード

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

'抽出トグルボタン
Private Sub ToggleButton1_Click()
    ToggleButton2.Value = Not ToggleButton1.Value
    CommandButton1.Enabled = Not ToggleButton1.Value
    If ToggleButton1.Value Then
        Frm抽出.Show
        If FillterCount = 0 Then
            ToggleButton1.Value = False
            ToggleButton2.Value = Not ToggleButton1.Value
            CommandButton1.Enabled = Not ToggleButton1.Value
        Else
            Sheets("メイン").Range("E3") = "( /" & FillterCount & " )"
            Sheets("メイン").Range("E3").Font.Color = vbRed
        End If
    End If
End Sub

'解除トグルボタン
Private Sub ToggleButton2_Click()
    ToggleButton1.Value = Not ToggleButton2.Value
    CommandButton1.Enabled = ToggleButton2.Value
    
    If ToggleButton2.Value = True Then
        Sheets("メイン").Range("E3") = "( /" & RecordCount & " )"
        Sheets("メイン").Range("E3").Font.Color = vbBlack
    End If
End Sub

メインフォーム

E4に抽出したレコード数が表示されます。
抽出したレコード数が表示

スポンサーリンク





メニューに戻る

■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します


Copyright (c) Excel-Excel ! All rights reserved