標準モジュールコード
下のコードに変更してください。
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に抽出したレコード数が表示されます。