'========================================================================================= ' 227 DAVERAGEで条件を満たすレコードの平均値を求める '----------------------------------------------------------------------------------------- '【ヒント】 ' このマクロは、おためし機能の動作用のコードを含んでいます。(概ね下半分) ' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。(概ね上半分) '========================================================================================= ' ◆標準モジュールのコード◆ '----------------------------------------------------------------------------------------- Option Explicit Dim DB範囲 As Range '★★★ Dim 条件範囲 As Range '★★★ Dim フィールド As String '★★★ Dim 平均値 As Double '★★★ Dim タイトル As String Dim スタイル As Long Dim メッセージ As String Dim 応答 As Variant '========================================================================================= Private Sub DAVERAGEで条件を満たすレコードの平均値を求める() Set DB範囲 = Worksheets("DB").Range("A1:D11") 'データベースのセル範囲 Set 条件範囲 = Worksheets("検索条件").Range("A1:E2") '検索条件のセル範囲 平均値 = Application.DAverage(DB範囲, "体重", 条件範囲) 'DSum関数 End Sub '========================================================================================= '----------------------------------------------------------------------------------------- Sub おためしマクロ() おためしメッセージを表示する Windows("227.XLS:1").Activate ' DAVERAGEで条件を満たすレコードの平均値を求める '★★★ ' おためしメッセージを表示する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 メッセージ = "DAVERAGE関数を VBAで使います。" & Chr(13) & Chr(13) & _ "「検索条件」シートの A1:E2セルで指定された条件を" & Chr(13) & Chr(13) & _ "満たすデータを、「DB」シートから検索し、" & Chr(13) & Chr(13) & _ "みつかったデータの平均値を取得します" 応答 = MsgBox(メッセージ, スタイル, タイトル) End Sub '----------------------------------------------------------------------------------------- Private Sub おためしメッセージを表示する2() メッセージ = "検索条件を満足するデータの" & Chr(13) & Chr(13) & _ "平均値は、" & 平均値 & " です" 応答 = MsgBox(メッセージ, スタイル, タイトル) Windows("227.XLS:2").Close Worksheets("Title").Select Range("P17").Select ActiveWindow.WindowState = xlMaximized End Sub '----------------------------------------------------------------------------------------- Sub Auto_Close() Application.DisplayAlerts = False '閉じる際に確認メッセージを出さない ActiveWorkbook.Close '現在開いているブックを閉じる End Sub '-----------------------------------------------------------------------------------------