データの平均とRangeの値をマクロで計算する方法を教えてください。 マクロ超初心者です。 任意のセ

データの平均とRangeの値をマクロで計算する方法を教えてください。
マクロ超初心者です。

任意のセルに、マウスで範囲選択したセルの平均値。
任意のセルの1つ下のセルに、先程と同じマウスで範囲選択したセルのRangeの値を出るようにマクロを組みたいと思っています。

例えば
A1〜A5に入力されてる値の平均値をB1
A1〜A5に入力されている値のRangeをB2（平均値の下のセル）
といったようにマクロを組みたいです。
A1〜A5の範囲は都度変わるので、そこをマウスで選択した範囲、平均値を入力したいセルB1も都度変わるので任意のセルにしたいです。

色々調べてみたのですが、分かりませんでした。
マクロは勉強していくつもりですが、取り急ぎ仕事で作業するにあたってマクロを組みたいので、よろしくお願いします。

No.6 ベストアンサー 回答者： WindFaller 回答日時： 2017/10/02 11:29

こんにちは。

以下は、ある意味ではお仕着せで、古いスタイル(Excel2003頃）のマクロです。ご自身の手に馴染むかなじまないかで、決まってきます。

・仕様
範囲は、マウスのドラッグで反転させて決めます。
範囲を選択したら、マウス・右クリックして、「個数」「合計」「平均」のどれかをクリックします。どれでも構いません。

セルの開いている所で、Ctrl + V または、貼り付け等で数値が出てきます。また、カーソルをセルに値の入っていない所で、再び、右クリックして、「個数」をクリックすれば、個数(CountA)が出てきます。

右クリックで、「個数」を選ばず、「平均」をクリックすれば、平均が出てきます。
範囲を選択することで、それらのデータはリセットされます。

・マクロの設置場所
当面は、そのブックの標準モジュール、気に入れば、個人用マクロブックの中の標準モジュールに入れてください。マクロのショートカットは、起動時に、設定されます。ブック単独の場合は、閉じれば設定も消えてしまいます。

'//標準モジュール

Private rng As Range
''Private pstFlg As Boolean '一回きりの出力用
Sub Auto_Open()
　Call RightClickMenus
End Sub
Sub Auto_Close()
　Application.CommandBars("CELL").Reset
End Sub

Sub RightClickMenus()
'Dim i As Integer
'右クリックメニュー登録
　With Application.CommandBars("CELL")
　　.Reset
　　With .Controls.Add _
　　　　(Type:=msoControlButton, Before:=1, Temporary:=True)
　　　.BeginGroup = False
　　　.Caption = "平均"
　　　.OnAction = "Calc_Average"
　　End With
　　With .Controls.Add _
　　　　(Type:=msoControlButton, Before:=1, Temporary:=True)
　　　.BeginGroup = False
　　　.Caption = "合計"
　　　.OnAction = "Calc_Sum"
　　End With
　　With .Controls.Add _
　　　　(Type:=msoControlButton, Before:=1, Temporary:=True)
　　　.BeginGroup = False
　　　.Caption = "個数"
　　　.OnAction = "Calc_Count"
　　End With
　End With
End Sub
Sub Main_Calc()
　If TypeName(Selection) = "Range" Then
　　If Selection.Count > 1 Then
　　　Set rng = Selection
　　　Exit Sub
　　End If
　　If rng Is Nothing And Selection.Count < 2 Then
　　　MsgBox "複数のセルを選んでください!", vbCritical: Exit Sub
　　End If
　End If
End Sub
Sub Calc_Average()
　Dim ret As Variant
　Call Main_Calc
　ret = Application.Average(rng)
　Call Output2ClipBoard(ret)
End Sub
Sub Calc_Sum()
　Dim ret As Variant
　Call Main_Calc
　ret = Application.Sum(rng)
　Call Output2ClipBoard(ret)
End Sub
Sub Calc_Count()
　Dim ret As Variant
　Call Main_Calc
　ret = Application.CountA(rng)
　Call Output2ClipBoard(ret)
End Sub


Sub Output2ClipBoard(ByVal ret As Variant)
　Dim objCb As Object
　Set objCb = CreateObject("new:1C3B4210-F441-11CE-B9EA-00AA006B1A69")
　On Error GoTo ErrHandler
　If VarType(ret) = vbDouble Then
　　Call objCb.SetText(ret)
　　Call objCb.PutInClipboard
　　If ActiveCell.Value = "" Then
　　　ActiveCell.PasteSpecial
　　Else
　　''　pstFlg = True
　　End If
ErrHandler:
　　Set objCb = Nothing
　End If
End Sub

添付画像は、右クリックのメニュー

No.5 回答者： ママチャリ 回答日時： 2017/09/30 10:07

不備の多いマクロなのですが、興味があればお読みください。

個人で使う分には問題ないと思います。

まず、下記のマクロを操作対象のシートのWorksheet_BeforeRightClickイベントプロシジャに張り付けて下さい。

【操作方法】
平均を求める範囲を範囲選択して右クリックしメニューを開きます。この時、メニュー項目を選択する必要はありません（右クリックすることに意味があります）。
次に平均値を入力したいセルを右クリックし、「貼り付け」を行います（できれば「値張り付け」を推奨します）。とりあえず、平均と合計が張り付くようにしています。

【注意事項など】
このマクロは、Sheet2を作業シートとして使用します。Sheet2が無い場合は、事前に作成しておいてください（空でOKです）。

GooUserラックさんのNo.3の説明にもある通り、このマクロも複数範囲の選択を行った場合、重複しているセルがダブってカウントされてしまいます。複数の範囲を選択する場合は、重複しないようにチマチマ選択してください。

シート全体を選択して右クリックすると異常終了します。この辺は、みのんさんが初心者を脱した時にでも考えてみて下さい。


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then
Sheets("Sheet2").Range("A1").Value = WorksheetFunction.Average(Target)
Sheets("Sheet2").Range("A2").Value = WorksheetFunction.Sum(Target)
Sheets("Sheet2").Range("A1:A2").Copy
End If
End Sub

No.4 回答者： fujillin 回答日時： 2017/09/29 14:26

こんにちは

＞範囲選択したセルのRangeの値
というのが何を意味しているのか分かりかねますが・・・
・選択範囲のアドレス？
・値の最大、最少の範囲？
などなどと妄想できますが、とりあえず範囲内の値のMAX、MINと考えました。
（VBA関連で「Range」と書くと、まずRangeオブジェクトを連想しますが、多分違う意味ですよね？）
一応、CtrlやShiftなどで複数範囲を選択した場合にも対応させています。

＞平均値を入力したいセルB1も都度変わるので任意のセルにしたいです
出力セル(B1)をどのように指定なさりたいのか不明なので、ひとまず、B1、B2セルは固定にしてあります。
出力対象セルを変えたい場合には、outCell（=セル位置）を可変にすれば良いでしょう。

対象範囲を全て選択した状態で、マクロを実行します。

Sub Sample()
Dim r As Range, t As Range
Dim rw As Long, rwL As Long, rwH As Long
Dim dSum, dNum As Long

Const outCell = "B1" '出力対象のセル

On Error Resume Next
Set r = Selection
On Error GoTo 0
If r Is Nothing Then Exit Sub

dSum = 0
dNum = 0
rwL = r.Row
rwH = rwL + r.Rows.Count - 1

For Each t In r.Areas
　wrL = WorksheetFunction.Min(rwL, t.Row)
　rwH = WorksheetFunction.Max(rwH, t.Row + t.Rows.Count - 1)
Next t

For rw = rwL To rwH
　Set t = Application.Intersect(r, Rows(rw))
　If Not t Is Nothing Then
　　If WorksheetFunction.Count(t) > 0 Then
　　　dNum = dNum + WorksheetFunction.Count(t)
　　　dSum = dSum + WorksheetFunction.Sum(t)
　　End If
　End If
Next rw

If dNum > 0 Then dSum = dSum / dNum Else dSum = CVErr(xlErrDiv0)
Range(outCell).Value = dSum
Range(outCell).Offset(1, 0).Value = _
　"max: " & WorksheetFunction.Max(r) & Chr(10) & _
　"min: " & WorksheetFunction.Min(r)

End Sub

No.3 回答者： GooUserラック 回答日時： 2017/09/29 04:18

No.2 のさらに補足

[Ctrl] キーや [Shift] キーを使っての複数エリアの選択には対応していない理由

・ [Ctrl] キーや [Shift] キーを押したときに「Worksheet_SelectionChange」イベントが発生してしまうため、押されるごとに処理確認が必要になるため
・ 下図の C6 セルのように重複エリアが有ると重複部を重複計算しないような仕組みを作るのが面倒なため

No.2 回答者： GooUserラック 回答日時： 2017/09/29 04:07

No.1 の補足

・ 平均を求めるエリアを選択していない状態で「平均値算出」マクロを呼び出してください。(マクロを呼び出す前に選択していると「Worksheet_SelectionChange」イベントが発生しないため)
・ [Ctrl] キーや [Shift] キーを使っての複数エリアの選択には対応していません。
・ 平均値を代入するセルを複数選択すると全てに平均値が代入されます。

No.1 回答者： GooUserラック 回答日時： 2017/09/29 03:55

以下のような感じではいかがでしょうか？

☆ 標準モジュールに
-----------------------------------------------------------------------------
Public モード As String
Public 平均値 As Variant
Sub 平均値算出()
モード = "平均"
MsgBox ("平均を求めるセルを選択してください。")
End Sub
-----------------------------------------------------------------------------
☆ 対象のシートモジュールに
-----------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim 合計 As Variant
Dim カウント As Long
Select Case モード
Case "平均"
If Target.Count > 1 Then
For カウント = 1 To Target.Count
If IsNumeric(Target(カウント).Value) Then
合計 = 合計 + Target(カウント).Value
End If
Next
平均値 = 合計 / Target.Count
MsgBox ("回答を書き込みたいセルを選択してください。")
モード = "回答"
End If
Case "回答"
Target.Value = 平均値
モード = ""
End Select
End Sub
-----------------------------------------------------------------------------