集計マクロ

質問

こんにちは。
早速ですが、例えばこんなカンジです。

[元データ(Sheet1)］
[1] 鈴木| 佐藤| 山田|・・・
[2]　茶　|　水　| 　　　|
[3]　魚　| 　　　|　酒　|
[4] 　　　|　肉　|　茶　|
[5]　肉　|　茶　|　魚　|

上記のようなデータから↓↓↓
１．行ごとに種類別に並べ替え
２．'=count(A2:D2)のような種類別の行集計列([数])を追加
３．[数]を基準に降順に並べ替え
↓↓↓
[集計データ(Sheet2)］
[1] 鈴木| 佐藤| 山田|・・・| 数
[2]　茶　|　茶　|　茶　|・・・| 3
[3]　肉　|　肉　| 　　　|・・・| 2
[4]　魚　|　　　 |　魚　|・・・| 2
[5] 　　　|　水　| 　　　|・・・| 1
[6] 　　　|　　　　| 酒　|・・・| 1
お解かりいただけますでしょうか(・_・;)？
今までは作業列（商品名）を挿入し、[VLOOKUP]→[COUNT]→値貼付→並べ替え→不要な商品名（行・列）を削除していましたが、度々では面倒に思い、マクロを組もうと試みました。
ですが、まだまだマクロ勉強中の私自身の頭が整理しきれず、行き詰ってしまいました。
アドバイスでも結構です。お力をお貸しください。
よろしくお願いいたします。

回答No.5

imogasi · ベストアンサー

例データ　Sheet1のA1:C7
鈴木 佐藤 山田
茶 水 ・・
魚 ・・ 酒
・・ 肉 茶
肉 茶 魚
リンゴ みかん
・・ ・・ 柿
コード
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim cl As Range
k = 2 'Sheetのスタート行
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
sh2.Range("B1:D1") = sh1.Range("A1:C1") '見出しSheet2へコピー
w = sh1.Range("iv1").End(xlToLeft).Column '右端列
MsgBox w
d = sh1.UsedRange.Rows.Count '最下行
MsgBox d
'--出てくる商品一覧作成
For Each cl In Range(sh1.Cells(2, "A"), sh1.Cells(d, w))
If cl = "" Then GoTo p01
For j = 2 To k
If sh2.Cells(j, "A") = cl Then GoTo p01
Next j
sh2.Cells(k, "A") = cl '新出商品セット
k = k + 1
p01:
Next
'----A列に出てくる商品にあわせて、その行に商品名セット
For j = 1 To w
For i = 2 To d
If sh1.Cells(i, j) = "" Then
Else
Set x = sh2.Range(sh2.Cells(2, "A"), sh2.Cells(k, "A")).Find(sh1.Cells(i, j))
If TypeName(x) = "Nothing" Then
Exit For
Else
sh2.Cells(x.Row, j + 1) = sh1.Cells(i, j)
End If
End If
Next i
Next j
End Sub
結果
Sheet2の　A1:D９（・・は空白。桁づれ防止のため入れた）
・・ 鈴木 佐藤 山田
茶 茶 茶 茶
水 ・・ 水
魚 魚 ・・ 魚
酒 。。 酒
肉 肉 肉
リンゴ リンゴ 、・・
みかん ・・ みかん
柿 ・・ ・・ 柿
少数例しかテストできてません。
後、カウント数はCOUNTやCOUNTIF関数でできるでしょう（略）
カウント数の多い商品順はカウント数が出ている列でソートすれば
よい（略）
コードは短いことを心がけました。急いだため、力足らずで、本番でエラーが無いこと、本番への修正がうまくいくこと、我慢ができる程度内の時間内に終わる事を祈る。

お礼

こんにちは。ご解答ありがとうございました。
早速、試してみたのですが、問題がありました。
例えば、商品1・・・「茶」、商品2・・・「紅茶」の「茶」ように商品の中には同じ単語が存在するものがあります。
この場合、［Find(sh1.Cells(i, j))］［Cells(i, j)="茶"］となると「茶」と「紅茶」が同一行に混在してしまいます。
何か、回避策等はありますでしょうか？

回答No.6

chem_taro

以下、1行目の「数」というセルを探し、数が０のものを非表示（削除ではなく）、さらに数をキーに降順ソートするマクロです。

突貫工事なので問題あれば言ってください。

Sub SortAndHide0()
'タイトルが「数」の列を探します。
For i = 1 To 100
If Cells(1, i) = "数" Then
r = i
End If
Next i
'全セルを選択
Cells.Select
'数が0のデータをフィルタで非表示に
Selection.AutoFilter Field:=r, Criteria1:="<>0"
'数を降順にソート
Selection.Sort Key1:=Range(Cells(2, r), Cells(2, r)), Order1:=xlDescending, Header:=xlYes
End Sub

以上マクロをVisual Basic Editorで追加しマクロを実行してください。

マクロ実行がめんどうであれば、シート状にフォームボタンを配置し、マクロを割り当てるとさらに楽に更新できます。

お礼

ありがとうございました。
先程、お２人の回答をもとにマクロを完成、動作テストの結果もダイジョブそうなものができました。
この回答をいただく直前に質問ページを見たきりで、勝手に試行錯誤している間にご回答をいただいたようです。
せっかくいただいたのに、まだ上記コードは試しておりませんが、改めて検証＆参考にさせていただきます。
ありがとうございました。

回答No.4

chem_taro

たとえばですが

#1の表に自動的に
１．「数」の列を参考に降順で並び替え
２．「数」が０のものを非表示（フィルタリング）
の操作が実行されれば、目的は達成できますか？

お礼

ありがとうございます。
補足を書かせていただきましたが、可能であれば上記でご提案いただいたような内容で、方法をアドバイスいただけませんか？
よろしくお願いいたします。

補足

こんにちは。
chem_taroサンがあげてくださった上記の実行が可能ならＯＫと考えています。
#3であげていただいた、「商品の追加」については、正直、考えていませんでした・・・。
新しい商品が登場するごとに「商品名マスタ」に追加（つまりは手動）しておけば、集計時には常に「商品名マスタ」＞「元データの商品名」となるカナと。安易でしょうか!?
もしや、自動で追加までできるのですか？？

回答No.3

chem_taro

VBAでマクロを組むならどんなことでもできるでしょうが、設計しようにもいまいちロジックが見えません。

一応、下の作例でも新しい商品ができたら、商品をつけたし、数式をコピーすれば動作するようには作っているのですが、商品の追加も自動で反映されるようにしたいってことかな？

もうちょっと詳しくお願いできますか？

回答No.2

imogasi

（１）茶、肉、・・に当たる項目はあらかじめ出て（判って）いますか
（２）茶、肉、・この順序（上行から下へ）に拘り（決まり）がありますか。
（３）佐藤の列で、例えば「肉」は、上下行で２箇所以上に現れますか。
しかしVBAでやるにしても、ロジックが簡単ではないように思う。

補足

こんにちは。ご連絡ありがとうございます。
（1）項目はあらかじめわかっていますが、上記のほか、=COUNT()の結果が「0(ゼロ)」のものもあり、これらの行は削除したい。
（2）ならびに決まりはありません。
（3）列に対して項目の出現は1つまでとします。
一連の流れとしてマクロを組みたいと考えていますが、難しいでしょうか？？？
よろしくお願いいたします。

回答No.1

chem_taro

茶とか肉とか魚とかの項目はあらかじめわかってるのでしょうか？

あらかじめわかっているのであれば

｜Ａ｜｜Ｂ｜｜Ｃ｜｜Ｄ｜・・・｜Ｚ｜
｜・｜｜鈴木｜佐藤｜山田・・・｜数｜
｜茶｜｜※｜｜※｜｜※｜・・・｜★｜
｜肉｜｜※｜｜※｜｜※｜・・・｜★｜
｜魚｜｜※｜｜※｜｜※｜・・・｜★｜
｜水｜｜※｜｜※｜｜※｜・・・｜★｜
｜酒｜｜※｜｜※｜｜※｜・・・｜★｜

Ａ列に項目の列をいれて
※には
=IF(COUNTIF(Sheet1!A$2:A$100,$A2)>0,$A2,"")
Sheet1の項目（A列）をカウントして1以上なら項目を表示、0ならヌル("")

★には横にCOUNTします。

わかりにくいですが、いかがでしょうか。

お礼

chem_taroサン、こんにちは。アドバイスありがとうございます。
ですが・・・ゴメンナサイ。意図しているところまでたどり着けないのです。
参考にさせていただきたいのですが、chem_taroサンの回答では
私が[VLOOKUP]を使ったコトと同様の作業と思います。
［補足］を記載いたします。
内容をご理解いただけましたら、再度ご回答をお待ちしたいと思います。
よろしくお願いいたします。

補足

ご解答の作業の後、「数」を基準に並べ替えをしたく、
また、質問では明記していませんでしたが「商品名」は上記のほか、=COUNT()の結果が「0(ゼロ)」のものもあり、これらの行は削除したく、一連の流れとしてマクロを組みたいと考えています。
よろしくお願いいたします。