A列を検索し一致した行を表示。さらにそれらの平均を出す。

質問

こんばんは、いつもお世話になっています。

今回は関数で出来るのかわからないんですが質問させてください。

　　　Ａ　　　Ｂ　　　Ｃ　　
　　商品名　　個数　販売数
１　りんご　　１　　　２
２　なし　　　３　　　５
３　ぶどう　　７　　　９
４　りんご　　２　　　４

上のようにSheet1に表があったとします。
Ａ列の「りんご」を検索し、１行目と４行目を別シートに表示
その結果を下のように平均・最大・最小という風に表示したいのですが可能でしょうか?

　　　Ａ　　　Ｂ　　　Ｃ　　
　　商品名　　個数　販売数
１　りんご　　１　　　２
２　りんご　　２　　　４
３　
４　最大　　　２
５　最小　　　１
６　平均　　　２

実際はに作っている表の列は「Ｚ」まであり、行も毎日入力するものなのでかなりの数になります。
自分でもいろいろ試してＡ列を=DGETで検索したのですが１つしか表示されなくてダメでした。

だめだめな自分にお知恵を貸してくださいm(_ _)m

回答No.6

ka_na_de

ka_na_deです。
おはようございます。

やはり、データが違うので予期せぬエラーがでますね。
改良しましたので、試して見てください。
見出しに空白行がある場合も考慮しました。

それと、エラー発生時はSUBプロシージャを抜けないように、
On Error Goto をコメントアウトしましたので、
エラー時はVBエディターに戻ります。
エラー時は、どこで止まってしまうか教えてください。

それから、Average関数は空白や文字列は自動的に無視して
計算してくれますので、そのまま使えると思います。

最後に、集計はE列から行うようにしました。（変数にしてます）

Sub test3()
'On Error GoTo Err
　　Dim MyKey As String
　　Dim St1Rng As Range, St2Rng As Range
　　Dim St1 As Worksheet, St2 As Worksheet
　　Dim LastRow As Long, LastCol As Long
　　Dim HeadLineNum As Long, KeyColumn As Long
　　Dim CalcStartCol As Long
　　Dim c As Long

　　Set St1 = Worksheets("Sheet1") '元データのシート
　　Set St2 = Worksheets("Sheet2") '抽出するシート

　　HeadLineNum = 3　 '見出し行の数
　　KeyColumn = 2　　 '検索列の番号
　　CalcStartCol = St2.Range("E1").Column　'集計開始列

　　'フィルター領域セット
　　Set St1Rng = St1.UsedRange

　　'フィルタ設定
　　St1Rng.AutoFilter

　　'検索ワードの要求
　　MyKey = Application.InputBox("検索ワード入力", Type:=2)
　　If MyKey = "False" Then Exit Sub

　　'変数MyKeyでデータ抽出
　　St1Rng.AutoFilter Field:=KeyColumn, Criteria1:=MyKey
　　St2.Cells.ClearContents

　　'可視セルをコピー&ペースト
　　St1Rng.SpecialCells(xlCellTypeVisible).Copy _
　　　　Destination:=St2.Range("A1").Offset(HeadLineNum - 1)

　　'フィルタ解除
　　St1Rng.AutoFilter

　　'見出し行のコピー&ペースト
　　St1.Rows("1:" & HeadLineNum).Copy _
　　　　Destination:=St2.Range("A1")

　　'最大、最小、平均の計算
　　With St2
　　　LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row　　　　　'最終行
　　　LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column　'最終列
　　　'基準の計算領域
　　　Set St2Rng = _
　　　　　　.Cells(1, CalcStartCol).Resize(LastRow - HeadLineNum).Offset(HeadLineNum)
　　　.Range("A" & LastRow + 2).Value = "最大"
　　　.Range("A" & LastRow + 3).Value = "最小"
　　　.Range("A" & LastRow + 4).Value = "平均"
　　　For c = CalcStartCol To LastCol
　　　　.Cells(LastRow + 2, c).Value = _
　　　　　　　　　WorksheetFunction.Max(St2Rng.Offset(, c - CalcStartCol))　'最大
　　　　.Cells(LastRow + 3, c).Value = _
　　　　　　　　　WorksheetFunction.Min(St2Rng.Offset(, c - CalcStartCol))　'最小
　　　　.Cells(LastRow + 4, c).Value = _
　　　　　　　　　WorksheetFunction.Average(St2Rng.Offset(, c - CalcStartCol))　'平均
　　　Next c
　　　.Range("A1").Select
　　End With

　　'変数の解放
　　Set St1 = Nothing
　　Set St2 = Nothing
　　Set St1Rng = Nothing
　　Set St2Rng = Nothing

　　Exit Sub
Err:
　MsgBox "error"
End Sub

回答No.5

kosamon

こんばんば。
まだ解決していないようなので・・・。

平均値なら
=AVERAGE(IF($A$2:$A$5="りんご",B$2:B$5,""))

と入力して＜SHIFT＞＋＜CTRL＞＋＜ENTER＞
でどうでしょう？

参照範囲はあえて絶対参照としています。
私ならこの式一つを入力した後下方向へフィル。
最大ならMAX、最小ならMINと書き換えます。
もちろん、このときも上記のキー操作で確定させます。

詳しくは下記URLを参照ください。

老婆心ながら・・・。
私もマクロ派なのでマクロは否定しませんが、質問者様の場合は
他の回答者様も書いておられるように「関数」を使用した方が
良いと思います。

参考URL：

http://pc.nikkeibp.co.jp/pc21/special/hr/hr4.shtml

回答No.4

ka_na_de

改良しました。

　元データ：Sheet1のA1～
　　　　　　３行見出し、４行目よりデータ
　　　　　　B列に検索ワードあり
　　　　　　C列～V？列まで数値データあり
　　　　　　（検索列の右隣から数値データと仮定してます）

　抽出データ：Sheet2のA1～
　　　　　　　抽出データの１行したから、集計計算
　　　　　　　A列：最大、最小、平均の見出し
　　　　　　　C列以降：計算結果

　データの場所など上記と異なるようであれば修正します。
　尚、検証が十分ではないので、エラーが出る場合は教えて下さい。

Sub test2()
On Error GoTo Err
　　Dim MyKey As String
　　Dim St1Rng As Range, St1Rng2 As Range, St2Rng As Range
　　Dim St1 As Worksheet, St2 As Worksheet
　　Dim LastRow As Long, LastCol As Long
　　Dim HeadLineNum As Long
　　Dim KeyColumn As Long
　　Dim c As Long

　　Set St1 = Worksheets("Sheet1") '元データのシート
　　Set St2 = Worksheets("Sheet2") '抽出するシート

　　HeadLineNum = 3 '見出し行の数
　　KeyColumn = 2 'B列（2列目）で検索

　　'アクティブセル領域
　　Set St1Rng = St1.Range("A1").CurrentRegion
　　'データ領域＋見出し１行
　　Set St1Rng2 = St1Rng.Resize(St1Rng.Rows.Count - HeadLineNum + 1).Offset(HeadLineNum - 1)

　　St1Rng2.AutoFilter　　　　　'フィルタ設定

　　'検索ワードの要求
　　MyKey = Application.InputBox("検索ワード入力", Type:=2)
　　If MyKey = "False" Then Exit Sub
　　'変数MyKeyでデータ抽出
　　St1Rng2.AutoFilter Field:=KeyColumn, Criteria1:=MyKey 　　
　　St2.Cells.ClearContents

　　'可視セルをコピー&ペースト
　　St1Rng.Resize(HeadLineNum - 1).Copy _
　　　　Destination:=St2.Range("A1")
　　St1Rng2.SpecialCells(xlCellTypeVisible).Copy _
　　　　Destination:=St2.Range("A1").Offset(HeadLineNum - 1)

　　St1Rng2.AutoFilter 'フィルタ解除

　　'最大、最小、平均の計算
　　With St2
　　　LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
　　　LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
　　　Set St2Rng = .Cells(1, KeyColumn + 1).Resize(LastRow - HeadLineNum).Offset(HeadLineNum) '基準の計算領域
　　　.Range("A" & LastRow + 2).Value = "最大"
　　　.Range("A" & LastRow + 3).Value = "最小"
　　　.Range("A" & LastRow + 4).Value = "平均"
　　　For c = KeyColumn + 1 To LastCol
　　　　.Cells(LastRow + 2, c).Value = _
　　　　　　　　　WorksheetFunction.Max(St2Rng.Offset(, c - KeyColumn - 1))
　　　　.Cells(LastRow + 3, c).Value = _
　　　　　　　　　WorksheetFunction.Min(St2Rng.Offset(, c - KeyColumn - 1))
　　　　.Cells(LastRow + 4, c).Value = _
　　　　　　　　　WorksheetFunction.Average(St2Rng.Offset(, c - KeyColumn - 1))
　　　Next c
　　　.Range("A1").Select
　　End With

　　Set St1 = Nothing
　　Set St2 = Nothing
　　Set St1Rng = Nothing
　　Set St1Rng2 = Nothing
　　Set St2Rng = Nothing

　　Exit Sub
Err:
　MsgBox "error"
End Sub

補足

何度もすみません。
エラーがでました。

Sheet2の見出しが4行で表示されてます。
1,2行目はSheet1と同じ1,2行目のセルなのですが、3行目に空白のセルが入り4行目にSheet1と同じ4行目のセルが入っています。

Sheet1のデータはE列からでV列まであります。
そのE列～V列まで全て、最大・最小・平均を出したいのです。

お手数ですが、時間がある時で構わないので宜しくお願いします。

回答No.3

ka_na_de

試しにVBAで作ってみました。
一例ですが、ご参考までに。
　元データ：Sheet1のA1～
　抽出データ：Sheet2のA1～
としています。　

Sub test()
On Error GoTo Err
　　Dim MyKey As String
　　Dim St1Rng As Range, St2Rng As Range
　　Dim St1 As Worksheet, St2 As Worksheet
　　Dim LastRow As Long, LastCol As Long
　　Dim c As Long

　　Set St1 = Worksheets("Sheet1") '元データのシート
　　Set St2 = Worksheets("Sheet2") '抽出するシート
　　Set St1Rng = St1.Range("A1").CurrentRegion 'アクティブセル領域取得

　　St1Rng.AutoFilter　'フィルタ設定

　　'検索ワードの要求
　　MyKey = Application.InputBox("検索ワード入力", Type:=2)
　　If MyKey = "False" Then Exit Sub
　　St1Rng.AutoFilter Field:=1, Criteria1:=MyKey 'MyKeyでデータ抽出

　　St2.Cells.ClearContents

　　'可視セルをコピー&ペースト
　　St1Rng.SpecialCells(xlCellTypeVisible).Copy _
　　　　Destination:=St2.Range("A1")

　　St1Rng.AutoFilter 'フィルタ解除

　　'最大、最小、平均の計算
　　With St2
　　　LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
　　　LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
　　　Set St2Rng = .Range("B2:B" & LastRow)　'基準の計算領域
　　　.Range("A" & LastRow + 2).Value = "最大"
　　　.Range("A" & LastRow + 3).Value = "最小"
　　　.Range("A" & LastRow + 4).Value = "平均"
　　　For c = 2 To LastCol
　　　　.Cells(LastRow + 2, c).Value = _
　　　　　　　　　WorksheetFunction.Max(St2Rng.Offset(, c - 2))
　　　　.Cells(LastRow + 3, c).Value = _
　　　　　　　　　WorksheetFunction.Min(St2Rng.Offset(, c - 2))
　　　　.Cells(LastRow + 4, c).Value = _
　　　　　　　　　WorksheetFunction.Average(St2Rng.Offset(, c - 2))
　　　Next c
　　End With
　　Exit Sub
Err:
　MsgBox "error"
End Sub

補足

VBAと大層なものを作っていただきありがとうございます。
早速、作っているシートに導入してみたのですが、やはりエラーがでました。

作っているのはA1からV3まで見出しがあり、検索する列はB列です。
色々いじってみたのですが、見出しが表示されず無理でした。

回答No.2

noname#204879

A　　　B　　　C　　 …
1　 最大　　　 7　　　 9　…
2　 最小　　　 1　　　 2　…
3　 平均　　3.25　　　 5　…
4
5　 商品名　個数　販売数　…
6　 りんご　　 1　　　 2　…
7　 なし　　　 3　　　 5　…
8　 ぶどう　　 7　　　 9　…
9　 りんご　　 2　　　 4　…
10　…　　　　…　　　…　…

B1: =SUBTOTAL(4,B$6:B$1000)
B2: =SUBTOTAL(5,B$6:B$1000)
B3: =SUBTOTAL(1,B$6:B$1000)
範囲 B1:B3 を右方にズズーッと複写

５行目で[オートフィルタ]を設定した後、「商品名」で“りんご”を選択してみてください。

回答No.1

134

ひとつの手法として

１．　1行目とA列に挿入をかけて、空けてください。

２．1行目に、2マス使って、左側を「検索データ」と入力する。
３．右側は、データ→入力規則→リスト　により、商品名のリストが、並ぶようにします。（仮に、このセルをＤ１セルとします）ついでなので、何か表示させておいてください。

　　１行目＝空き、２行目＝タイトル（商品名、個数、販売数…）となり、３行目からデータが並ぶことになりますよね。（Ｂ３よりデータが始まると思います）

４．Ａ３セルに以下の数列を入れます。
=if(b3=$d$1,max($b$2:b2)+1,"")
そして、この関数を下までドラッグします。

Ｄ１で指定した商品だけ、ナンバーリングされると思います。

５．Ａ２から、表全体を覆い、なお余分にドラッグし、挿入→名前で名前をつけます。（仮に「一覧表」と名付けます）

６．シート２を選択します。

７．１行目に　最大値、最小値、平均　と入れておきます。
　　３行目に表題を入れます（Ａ３＝商品名、Ｂ３＝個数、Ｃ３＝販売数…）
８．Ａ４セルに以下の関数を入力します。
=IF(ISERROR(VLOOKUP(ROW()-3,一覧表,2,0)),"",VLOOKUP(ROW()-3,一覧表,2,0))

９．Ｂ４セルに以下の関数を入力します。
=IF(ISERROR(VLOOKUP(ROW()-3,一覧表,3,0)),"",VLOOKUP(ROW()-3,一覧表,3,0))

10．Ｃ４セルに以下の関数を入力します。
=IF(ISERROR(VLOOKUP(ROW()-3,一覧表,4,0)),"",VLOOKUP(ROW()-3,一覧表,4,0))

11．Ａ４～Ｃ４セルを選択し、関数を下までコピーします。

　ここで、シート1Ｄ１セルで選択したデータが列挙されると思います。

12．最大値、最小値、平均を通常通り、範囲指定して下さい。

Ｚ列まで使用ということで、最大、最小、平均をどのデータでどのように表示したいのか分かりませんので、このように書きました。

row()により、検索をかけていますので、１～３行目をそれぞれ最大、最小、平均とし、4行目に表題、5行目からデータという場合には、row()-4とすれば対応可能です。

いかがでしょうか？