データの平均とRangeの値をマクロで計算する方法を教えてください。
マクロ超初心者です。
任意のセルに、マウスで範囲選択したセルの平均値。
任意のセルの1つ下のセルに、先程と同じマウスで範囲選択したセルのRangeの値を出るようにマクロを組みたいと思っています。
例えば
A1〜A5に入力されてる値の平均値をB1
A1〜A5に入力されている値のRangeをB2(平均値の下のセル)
といったようにマクロを組みたいです。
A1〜A5の範囲は都度変わるので、そこをマウスで選択した範囲、平均値を入力したいセルB1も都度変わるので任意のセルにしたいです。
色々調べてみたのですが、分かりませんでした。
マクロは勉強していくつもりですが、取り急ぎ仕事で作業するにあたってマクロを組みたいので、よろしくお願いします。
No.1
- 回答日時:
以下のような感じではいかがでしょうか?
☆ 標準モジュールに
-----------------------------------------------------------------------------
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
-----------------------------------------------------------------------------
No.2
- 回答日時:
No.1 の補足
・ 平均を求めるエリアを選択していない状態で「平均値算出」マクロを呼び出してください。(マクロを呼び出す前に選択していると「Worksheet_SelectionChange」イベントが発生しないため)
・ [Ctrl] キーや [Shift] キーを使っての複数エリアの選択には対応していません。
・ 平均値を代入するセルを複数選択すると全てに平均値が代入されます。
No.3
- 回答日時:
No.2 のさらに補足
[Ctrl] キーや [Shift] キーを使っての複数エリアの選択には対応していない理由
・ [Ctrl] キーや [Shift] キーを押したときに「Worksheet_SelectionChange」イベントが発生してしまうため、押されるごとに処理確認が必要になるため
・ 下図の C6 セルのように重複エリアが有ると重複部を重複計算しないような仕組みを作るのが面倒なため
No.4
- 回答日時:
こんにちは
>範囲選択したセルの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.5
- 回答日時:
不備の多いマクロなのですが、興味があればお読みください。
個人で使う分には問題ないと思います。まず、下記のマクロを操作対象のシートの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.6ベストアンサー
- 回答日時:
こんにちは。
以下は、ある意味ではお仕着せで、古いスタイル(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
添付画像は、右クリックのメニュー
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) Excelのマクロについて教えてください。 1 2023/03/12 12:16
- Visual Basic(VBA) Excelのマクロコードについて教えてください。 1 2022/03/27 13:25
- Visual Basic(VBA) データのある範囲を選択するVBAについて 2 2022/09/03 00:20
- Excel(エクセル) エクセルのマクロについて教えてください。 3 2023/02/07 14:47
- Excel(エクセル) エクセルのマクロについて教えてください。 2 2023/02/26 13:19
- Excel(エクセル) 【VBA】エクセルで選択した範囲の値のみをクリップボードにコピーするコードについて 3 2023/03/08 17:41
- Visual Basic(VBA) vbaエクセルマクロ RemoveDuplicatesについて RemoveDuplicatesを使 3 2023/02/28 01:13
- Visual Basic(VBA) vbaエクセルマクロ RemoveDuplicatesについて RemoveDuplicatesを使 1 2023/02/27 22:21
- Visual Basic(VBA) エクセルのマクロについて教えてください マクロを実行して 作業フォルダの中にある PDFファイル名を 3 2023/07/01 15:16
- Excel(エクセル) Excleマクロ セル値の代入と文字列の結合について 3 2022/10/05 16:47
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
EXCELで特定のセルに表示...
-
エクセル 数字をすべて○などの...
-
クリックすると文章が表示され...
-
Excel内での検索結果をシート...
-
セル背景や文字を点滅させる方法
-
Excel2007 色のカウント (VBA)
-
太字に設定されているセルの個...
-
【EXCEL】先週の月曜日の日付を...
-
空白セルを空セルに置き換える...
-
フォントの色を指定して削除出...
-
[エクセル VBA]テキストファ...
-
Excelでセルをクリックす...
-
EXCELのセルや文字色の反映
-
Excelで、図形内の文字をセルに...
-
Excelで挿入した図をセルの中央...
-
未記入がある場合はマクロを実...
-
エクセル マクロ 相対パスか...
-
VBA 見つからなかった時の処理
-
マクロを実行すると画像がズレ...
-
セルの値が変ると自動でマクロ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
EXCELで特定のセルに表示...
-
エクセル 数字をすべて○などの...
-
Excel内での検索結果をシート...
-
クリックすると文章が表示され...
-
Excelでセルをクリックす...
-
太字に設定されているセルの個...
-
Excel ハイパーリンクのURLを別...
-
Excelで、図形内の文字をセルに...
-
マクロを実行すると画像がズレ...
-
現在のセルの位置を返す関数は...
-
Excelで挿入した図をセルの中央...
-
フォントの色を指定して削除出...
-
VBA 見つからなかった時の処理
-
エクセルでの検索ボックスの作...
-
エクセル 未入力セルがあると...
-
Excel2007 色のカウント (VBA)
-
エクセルでPDFリンクを大量...
-
【EXCEL】先週の月曜日の日付を...
-
EXCELのセルや文字色の反映
-
セルがクリックされた回数をカ...
おすすめ情報