'========================================================================================= ' 230 DSUMで条件を満たすレコードの合計を求める '----------------------------------------------------------------------------------------- '【ヒント】 ' このマクロは、おためし機能の動作用のコードを含んでいます。(概ね下半分) ' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。(概ね上半分) '========================================================================================= ' ◆標準モジュールのコード◆ '----------------------------------------------------------------------------------------- Option Explicit Dim DB範囲 As Range '★★★ Dim 条件範囲 As Range '★★★ Dim フィールド As String '★★★ Dim 合計 As Long '★★★ Dim タイトル As String Dim スタイル As Long Dim メッセージ As String Dim 応答 As Variant '========================================================================================= Private Sub DSUMで条件を満たすレコードの合計を返す() '★★★ Set DB範囲 = Worksheets("DB").Range("A1:G11") 'データベースのセル範囲 Set 条件範囲 = Worksheets("検索条件").Range("A1:G2") '検索条件のセル範囲 合計 = Application.DSum(DB範囲, "売掛金残高", 条件範囲) 'DSum関数 End Sub '========================================================================================= '----------------------------------------------------------------------------------------- Sub おためしマクロ() おためしメッセージを表示する Windows("230.XLS:1").Activate ' DSUMで条件を満たすレコードの合計を返す '★★★ ' おためしメッセージを表示する2 End Sub '----------------------------------------------------------------------------------------- Private Sub おためしメッセージを表示する() Worksheets("DB").Activate ActiveWindow.WindowState = xlMaximized ActiveWindow.NewWindow Windows.Arrange ArrangeStyle:=xlHorizontal Worksheets("検索条件").Select Range("A1").Select 'カーソルを定位置へ移動する タイトル = "500連発 第2弾 サンプルマクロ" スタイル = 64 'vbInformation メッセージ = "DSUM関数を VBAで使います。" & Chr(13) & Chr(13) & _ "「検索条件」シートの A1:G2セルで指定された条件を" & Chr(13) & Chr(13) & _ "満たすデータを、「DB」シートから検索し、" & Chr(13) & Chr(13) & _ "みつかったデータの '売掛金残高' を合計します" 応答 = MsgBox(メッセージ, スタイル, タイトル) End Sub '----------------------------------------------------------------------------------------- Private Sub おためしメッセージを表示する2() メッセージ = "検索条件を満足するデータの、" & Chr(13) & Chr(13) & _ "'売掛金残高' は、" & 合計 & "です" 応答 = MsgBox(メッセージ, スタイル, タイトル) Windows("230.XLS:2").Close Worksheets("Title").Activate Range("P17").Select 'カーソルを定位置へ移動する ActiveWindow.WindowState = xlMaximized End Sub '----------------------------------------------------------------------------------------- Sub Auto_Close() Application.DisplayAlerts = False '閉じる際に確認メッセージを出さない ActiveWorkbook.Close '現在開いているブックを閉じる End Sub '-----------------------------------------------------------------------------------------