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

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




Homeに戻る > Excelでアプリケーションソフト > 取引先表アプリ

標準モジュールコード

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

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に抽出したレコード数が表示されます。
抽出したレコード数が表示

Homeに戻る > Excelでアプリケーションソフト > 取引先表アプリ

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


Copyright (c) Excel-Excel ! All rights reserved