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

Step 12 「抽出」コードの作成 その4 ユーザーフォームの変更


これまで抽出結果をメインフォームに表示しようとしていたが、あまりに複雑になり分かり難いので、ユーザーフォームに表示するように変更する。


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

標準モジュールコード

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

Option Explicit

'データ変更の有無
Public bDataChangeFlag As Boolean
'抽出結果数を保持
Public RecordCount As Long

抽出フォームコード

下のコードを追加してください。

Private Sub ExEnabled(bsw As Boolean)
    Dim lcol As Long
    
    Frame1.Enabled = bsw
    If bsw Then
        lcol = -2147483643
    Else
        lcol = 14737632
    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
    
    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
            ExEnabled False
            Label14.Caption = "見つかりませんでした。"
        Else
            ExEnabled True
            Label14.Caption = last - 4 & " 件見つかりました。"
            FillterCount = last - 4
        End If
        Label14.Visible = True
    End If
End Function

Private Sub UserForm_Initialize()
    ExEnabled False
End Sub



メインシートコード

下のコードを削除してください。

'抽出トグルボタン
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

下のコードを追加してください。
Private Sub CommandButton7_Click()
    Frm抽出.Show
End Sub

メインフォーム

抽出結果表示部分を追加します。


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

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


Copyright (c) Excel-Excel ! All rights reserved