エクセル いろいろな品名ごとに条件付きのカウントをしたい。

質問

エクセルマクロについて教えてください。

以下の「元の表」から「抽出した表」のように、○がついているもののカウントをしたいのですが、マクロでやるにはどのようにしたらよいでしょうか。
品名は特定なものではなく、無限にあります。

〔元の表〕
品名 区分
りんご ○
りんご ×
みかん ○
バナナ ○
バナナ ×
キウイ ○
りんご ×
キウイ ○
りんご ○
　　：
　　：

〔抽出した表〕
品名　　区分 数量
りんご ○ 2
みかん ○ 1
バナナ ○ 1
キウイ ○ 2
　　：
　　：

回答No.5

hallo-2007

作業列案
元の表のC列に　=A2&B2 下フィル
抽出した表のC列に　=COUNTIF(元の表のシート名のC列,A2&B2) 下フィル

配列関数案
=SUMPRODUCT((元表のシート!A2:A1000=A2)*(元表のシート!A2:A1000=B2))
SUMPRODUCT関数は、Helpでは、詳しく出ていませんのでネットで検索してみてください。

そのほか、
ピボットテーブル案
DCOUNT,DSUM案あります。Helpで調べてみてください。

回答No.4

shiroshi_1970

これで一応できますが。元のデータは残りません。

Sub sample()

'---重複削除＆○以外削除---

'ソートする
Rwe = Range("A" & 65536).End(xlUp).Row
Range("A1:B" & Rwe).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal

'○以外削除
Rwe = Range("A" & 65536).End(xlUp).Row
For R = Rwe To 1 Step -1
If InStr(Range("B" & R).Value, "○") = 0 Then
Rows(R).Delete
End If
Next

'重複削除
Rwe = Range("B" & 65536).End(xlUp).Row
For R = Rwe To 2 Step -1
If Range("A" & R).Value = Range("A" & R - 1).Value Then
Rows(R).Delete
End If
Next
End Sub

回答No.3

suz83238

区分の次に○なら１という列を作ります。（例えばＣ列）
オートフィルターを使って"りんご"で"○"を選択し、出てきたものを=subtotal(9,c1:c100)とした方がいいんじゃないですか？これをそれぞれの果物にすればＯＫだと思う。

例
りんご　○　１
りんご　×
みかん　○　１

回答No.2

imogasi

（１）Ｓｈｅｅｔ１のデータ最終行を知る
d = sh1.Range("A65536").End(xlUp).Row 　sh1については後述
初期値として、Ｓｈｅｅｔ２の最終行を２とかに設定。
（２）データ最初行から最終行まで毎行繰り返す
For Next
（３）繰り返すのは区分セルが○かどうかという判別
ＩＦ文を使う。
（４）○ならＳｈｅｅｔ２の品目リストの２ー＞Ｋ－１行にあるかどうか調べる。
（５）Ｓｈｅｅｔ２の表に品名があればその行の出現頻度数のセルに＋１。次のＳｈｅｅｔ１の行へ処理を移す。
（６）無ければＳｈｅｅｔ２の最終行の次の行に
そしてＳｈｅｅｔ２の最終行を１行下げる
Ｋ＝Ｋ＋１
品名と区分をＳｈｅｅｔ１から持ってきて１行分セットし
出現頻度数を１とする。
次のＳｈｅｅｔ１の行へ処理を移す。
ーー
Ｓｈｅｅｔ１，Ｓｈｅｅｔ２のセルを区別するには
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
・・・
End Sub
とし、セルは必ずSh1.cells(i,J)のように表現して使う。

お礼

お答えありがとうございます。
参考にやってみようと思います。

回答No.1

hallo-2007

特にVBAにこだわらなくても良いような気がします。
エクセルの関数の得意とする所のような質問なのですが、
何かマクロでなくてはならない理由があるのでしょうか。

お礼

お答えありがとうございます。
ＶＢＡでなくても、問題ありません。
よろしくお願いします。