(2)subtotal関数
(a)エクセルの関数と概要
エクセルの関数は全件数はcount(A4:A16) すべての合計はsum(A4:A16)
フィルターをつけて抽出した選んだ件数はsubtotal(2,A4:A16)
選んだ合計はsubtotal (9,A4:A16)
2はカウントの引数9は合計の引数
VBAの場合はフォームを使って抽出を行います。
フィルターの方が各項目を自由に選べて楽に見えますがパソコンに慣れていない方にとってみればフォームでチェックボックス等で選ぶ方が使いやすいと思います。
(b)抽出フォーム
フォームを作る時は各オブジェクトに名前を付けないといけません。
フォーム名をfrmTyusyutuとします。
フォームをボタンとリンクするために標準モジュールに
Sub tyusyutu()
frmTyusyutu.Show
End Sub
を書きます。
フォームが呼ばれた時に初期値を代入します。
日付・金額とも最小値・最大値を条件文のついた繰り返しで取得します。
次のプログラムを参考にしてフォームを作成してください。
Private Sub UserForm_Initialize()
Dim i As Long
Dim sdate As Date
Dim edate As Date
Dim skingaku As Long
Dim ekingaku As Long
'日付
sdate = Cells(4, 1)
edate = Cells(4, 1)
For i = 4 To 16
If sdate >= Cells(i, 1) Then
sdate = Cells(i, 1)
End If
If edate <= Cells(i, 1) Then
edate = Cells(i, 1)
End If
Next
txtSdate.Text = sdate
txtEdate.Text = edate
'費目
chkKoutuuhi.Value = True
chkJimu.Value = True
chkSyouhin.Value = True
'金額
skingaku = 0
txtSkin.Text = skingaku
ekingaku = Cells(4, 3)
For i = 7 To 21
If ekingaku <= Cells(i, 3) Then
ekingaku = Cells(i, 3)
End If
Next
txtEkin.Text = ekingaku
End Sub
(c)データの抽出
3つの抽出条件(日付・費目・金額)の該当データを一気に取り出すことはできないことはないですが、例えばエクセルの3重IF文を考えてみてください。
1つの条件づつシートに取り出してはまた次の作業シートに取り出す方法であればわかりやすいと思います。
実行ボタンを押したときに抽出を行い最後に結果をもとの抽出箇所にコピーします。
Private Sub cmdJikkou_Click()
Dim i As Long
Dim kensu As Long
Dim kingaku As Long
Dim j As Long
Dim lastrow As Long
'クリアにする
'作業シート
For i = 1 To 13
Worksheets("作業").Cells(i, 1) = ""
Worksheets("作業").Cells(i, 2) = ""
Worksheets("作業").Cells(i, 3) = ""
Next
'作業1シート
For i = 1 To 13
Worksheets("作業1").Cells(i, 1) = ""
Worksheets("作業1").Cells(i, 2) = ""
Worksheets("作業1").Cells(i, 3) = ""
Next
'抽出シートの表示
For i = 4 To 16
Worksheets("明細").Cells(i, 5) = ""
Worksheets("明細").Cells(i, 6) = ""
Worksheets("明細").Cells(i, 7) = ""
Next
'全データの件数・金額
For i = 4 To 16
kensu = kensu + 1
kingaku = kingaku + Cells(i, 3)
Next
Worksheets("明細").Cells(1, 3) = kensu
Worksheets("明細").Cells(1, 5) = kingaku
j = 1
'作業シートに取り出す
'日付の取り出し
For i = 4 To 16
If Worksheets("明細").Cells(i, 1) >= txtSdate.Text And Worksheets("明細").Cells(i, 1) <= txtEdate.Text Then
Worksheets("作業").Cells(j, 1) = Cells(i, 1)
Worksheets("作業").Cells(j, 2) = Cells(i, 2)
Worksheets("作業").Cells(j, 3) = Cells(i, 3)
j = j + 1
End If
Next
'費目の取り出し
lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
j = 1
For i = 1 To lastrow
If chkKoutuuhi.Value = True Then
If Worksheets("作業").Cells(i, 2) = chkKoutuuhi.Caption Then
Worksheets("作業1").Cells(j, 1) = Worksheets("作業").Cells(i, 1)
Worksheets("作業1").Cells(j, 2) = Worksheets("作業").Cells(i, 2)
Worksheets("作業1").Cells(j, 3) = Worksheets("作業").Cells(i, 3)
j = j + 1
End If
End If
If chkJimu.Value = True Then
If Worksheets("作業").Cells(i, 2) = chkJimu.Caption Then
Worksheets("作業1").Cells(j, 1) = Worksheets("作業").Cells(i, 1)
Worksheets("作業1").Cells(j, 2) = Worksheets("作業").Cells(i, 2)
Worksheets("作業1").Cells(j, 3) = Worksheets("作業").Cells(i, 3)
j = j + 1
End If
End If
If chkSyouhin.Value = True Then
If Worksheets("作業").Cells(i, 2) = chkSyouhin.Caption Then
Worksheets("作業1").Cells(j, 1) = Worksheets("作業").Cells(i, 1)
Worksheets("作業1").Cells(j, 2) = Worksheets("作業").Cells(i, 2)
Worksheets("作業1").Cells(j, 3) = Worksheets("作業").Cells(i, 3)
j = j + 1
End If
End If
Next
'作業シートクリアにする
For i = 1 To 15
Worksheets("作業").Cells(i, 1) = ""
Worksheets("作業").Cells(i, 2) = ""
Worksheets("作業").Cells(i, 3) = ""
Next
'金額の取り出し
lastrow = Worksheets("作業1").Cells(Rows.Count, 1).End(xlUp).Row
j = 1
For i = 1 To lastrow
If Worksheets("作業1").Cells(i, 3) >= Val(txtSkin.Text) And Worksheets("作業1").Cells(i, 3) <= Val(txtEkin.Text) Then
Worksheets("作業").Cells(j, 1) = Worksheets("作業1").Cells(i, 1)
Worksheets("作業").Cells(j, 2) = Worksheets("作業1").Cells(i, 2)
Worksheets("作業").Cells(j, 3) = Worksheets("作業1").Cells(i, 3)
j = j + 1
End If
Next
'作業シート抽出データの件数・金額
lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
kensu = 0
kingaku = 0
For i = 1 To lastrow
kensu = kensu + 1
kingaku = kingaku + Worksheets("作業").Cells(i, 3)
Next
Worksheets("明細").Cells(2, 3) = kensu
Worksheets("明細").Cells(2, 5) = kingaku
'抽出データの表示
j = 4
For i = 1 To lastrow
Worksheets("明細").Cells(j, 5) = Worksheets("作業").Cells(i, 1)
Worksheets("明細").Cells(j, 6) = Worksheets("作業").Cells(i, 2)
Worksheets("明細").Cells(j, 7) = Worksheets("作業").Cells(i, 3)
j = j + 1
Next
Unload Me
End Sub