表から０以外の数値を取り出し羅列したい

質問

何から考えていいのか分かりません・・。
Excel200で下記のような表があります。

ID　　顧客名　サービス１　サービス２　サービス３・・・・
─────────────────────────
****　ＡＡＡ　　　　　０　　　　　０　　　　　０
****　ＢＢＢ　　　　　０　　　　　０　　　　１１
****　ＣＣＣ　　　　　１　　　　１６　　　　　０
****　ＤＤＤ　　　　　０　　　　　０　　　　　３
　・　　・　　　　　　・　　　　　・　　　　　・
　・　　・　　　　　　・　　　　　・　　　　　・
　・　　・　　　　　　・　　　　　・　　　　　・

この表からデータが０でないものをピックアップし、
次のような一覧を作成したいのです

顧客名　サービス名　件数
─────────────
ＢＢＢ　サービス３　１１
ＣＣＣ　サービス１　　１
ＣＣＣ　サービス２　１６
ＤＤＤ　サービス３　　３

こういったことは可能なのでしょうか？
過去のものも見てみたのですが、うまく合致するものを探せず、
Excelの関数のヘルプを見ても、よくわからず、困ってしまいました。

関数は多少使ったことがありますが、
マクロは使ったことがありません。
ご指導いただける方がいらっしゃいましたらどうぞ宜しくお願い致します。

回答No.6

nishi6 · ベストアンサー

関数でもできそうですが、マクロのほうがはるかに簡単にできます。

Sheet1が下のようになっており、

　　　　Ａ　　　Ｂ　　　　Ｃ　　　　　Ｄ　　　　　Ｅ　　　・・・
１　　ＩＤ　　顧客名　サービス１　サービス２　サービス３　・・・
２　＊＊＊＊　ＡＡＡ　　　０　　　　　０　　　　　０
３　＊＊＊＊　ＢＢＢ　　　０　　　　　０　　　　１１
４　＊＊＊＊　ＣＣＣ　　　１　　　　１６　　　　　０
５　＊＊＊＊　ＤＤＤ　　　０　　　　　０　　　　　３　　　・・・

これをSheet2に次のように集計してみます。（２行目から集計）

　　　　Ａ　　　Ｂ　　　　Ｃ
１　顧客名　サービス名　件数
２　ＢＢＢ　サービス３　１１
３　ＣＣＣ　サービス１　　１
４　ＣＣＣ　サービス２　１６
５　ＤＤＤ　サービス３　　３

ツール→マクロ→Visual Basic Editor でVBE画面に移り、 表示→プロジェクトエクスプローラでプロジェクトエクスプローラを表示します。
プロジェクトエクスプローラのSheet1をダブルクリック。出てきたコードウインドウに下記マクロをコピーして貼り付けます。

シートに戻り、ツール→マクロ→マクロでこのマクロ（ichiran）を指定して実行します。

ここからコピーします
↓
Sub ichiran()
　　Dim rw As Long '調べる行
　　Dim col As Integer '調べる列
　　Dim outRw As Long '書き出す行

　　outRw = 2
　　With Worksheets("Sheet2")
　　　　.Cells.Clear
　　　　.Range("A1:C1") = Array("ID", "サービス名", "件数")
　　　　For rw = 2 To Range("B65536").End(xlUp).Row
　　　　　　For col = 3 To Range("IV" & rw).End(xlToLeft).Column
　　　　　　　　If Cells(rw, col).Value > 0 Then
　　　　　　　　　　.Cells(outRw, 1) = Cells(rw, 2)
　　　　　　　　　　.Cells(outRw, 2) = Cells(1, col)
　　　　　　　　　　.Cells(outRw, 3) = Cells(rw, col).Value
　　　　　　　　　　outRw = outRw + 1
　　　　　　　　End If
　　　　　　Next
　　　　Next
　　End With
End Sub

お礼

ありがとうございました！！！
感動しました。

ご指導頂いた通り、作業させていただき、マクロを実行したら「感動！！」。
欲しかった一覧表が出来あがってました。

マクロを全く自分でくんだことがないので、作っていただいたマクロを一つ一つ拝見しながら、
勉強させていただきたいと思います。

本当にありがとうございました。

回答No.5

imogasi

＃４のものです。
１つのデータ列だけ持ったデータに直し方を紹介します。
テストデータとしてＡ１：Ｅ６に
1 ＡＡＡ 0 0 0
2 ＢＢＢ 0 0 11
3 ＣＣＣ 1 16 0
4 ＤＤＤ 0 0 3
5 ＥＥＥ 31 0 0
6 ＦＦＦ 0 23 0
を用意してください。
Ｇ１：Ｉ１８までの範囲に展開します。
下記関数式で３が出てくるのは
このテスト例ではデータ列をＣ、Ｄ、Ｅ列の３で作っているからです。ＭＯＤは割ったあまり、ＩＮＴは商、ＲＯＷ
は自分の行数字です。ＩＮＤＥＸは行、列数字を指定してそのセルの値を取ってくる関数です。詳しくは調べてください。＄は絶対番地です、落とさないように。
（１）Ｇ１に入れる式－－－＞
=INDEX($A$1:$E$6,INT((ROW()-1)/3)+1,1)
（２）Ｈ１に入れる式－－－＞
=INDEX($A$1:$E$6,INT((ROW()-1)/3)+1,2)
（３）Ｉ１に入れる式－－－＞
INDEX($A$1:$E$6,INT((ROW()-1)/3)+1,MOD(ROW()-1,3)+3)
（４）Ｇ２：Ｇ１８までＧ１を複写してください。
Ｈ２：Ｈ１８までＨ１を複写してください。
Ｉ２：Ｉ１８までＩ１を複写してください。
「１８」は６行Ｘデータ列３＝１８からきます。
結果は
1 ＡＡＡ 0
1 ＡＡＡ 0
1 ＡＡＡ 0
2 ＢＢＢ 0
2 ＢＢＢ 0
2 ＢＢＢ 11
3 ＣＣＣ 1
3 ＣＣＣ 16
3 ＣＣＣ 0
4 ＤＤＤ 0
4 ＤＤＤ 0
4 ＤＤＤ 3
以下略。のようになります。
これでＣ列０をフィルタでかけて省きましょう。
●本件は＃４で関数式で出来ないと言ったことと矛盾しませんのでよろしく。
（１）規則性があった（利用した）こと。データセルは各行３列あるのでこれを幸い使ったもの。
（２）手操作のフィルタ操作（データ－フィルタ－オートフィルタまたはフィルタオプション）を使っていること。
がある問題なので解決したわけです。

回答No.4

imogasi

●ＶＢＡ（マクロ）でないと無理でしょう。
あるいは手操作で一歩一歩やるとか。それにしてもノンゼロの列数分を行数分に増やすのはどうするか難しそう。いっそのこと０も含めて、セル分だけ行を増やし、０分を
フィルタにかけるとかどうでしょう。
●もとの表（元表）に比べ目的の表（目的表）は例えばＣＣＣだけ見ると行数が増えています。
こういう風に場合に応じた数だけの行挿入をしなくてはならない問題は、関数では難しいと思います。
また３列がすべて０のとき、自分自身の行を削除するのも関数で出来ません（不可能といいたいが、工夫した回答が出るかもしれないので控えめに。）
●関数はまたセルのデータを見て判断する（そして演算に使う）は自由に出来ますが、あるセル(例えばＡ１セル）に関数式を書いて、他のセル（例えばＡ１とは別のＣ１セル）にデータをセットできません。データをセットしたいセルに式を書かないといけません。ピックアップ後の「目的表」の例えば第３行目にデータを入れるとします。関数式をいれないと、「元表」からデータを持ってこれませんので式をいれようしますが、その時「元表」の何行目・何列目をもってくるのかが関数式で書けない（正確には複写できるようにかけない）のです。
人間が、目的表に
（Ａ列）（Ｂ列）（Ｃ列）
＝Ｂ４　＝Ｅ１　＝Ｅ４
＝Ｂ５　＝Ｃ１　＝Ｃ５
＝Ｂ５　＝Ｄ１　＝Ｄ５
＝Ｂ６　＝Ｅ１　＝Ｅ６
・・・
と人間が目で見て勘定して案配していれていけば完成しますがそれは目指すものではない。
この列文字部分と行数字部分を目的表のデータ部の第１行目（各列で別になってもでも良いが）に作ることができれば、第２行以下は複写すれば良いのですが、そういう式を作ることが出来ません。
●ＶＢＡでやるとすると、
ＩＤ＋顧客名＋１つのセルデータの形に、データ部の全セルについて行い、セル部データが、０のものを捨てれば良いから処理は簡単です。下記のように骨子は１５行ぐらいです。Ｓｈｅｅｔ２に出来あがります。
Sub test01()
d = Range("a1").CurrentRegion.Rows.Count
r = Range("a1").CurrentRegion.Columns.Count
k = 1
For i = 1 To d
For j = 3 To r
If Cells(i, j) <> 0 Then
Worksheets("sheet2").Cells(k, 1) = Cells(i, 1)
Worksheets("sheet2").Cells(k, 2) = Cells(i, 2)
Worksheets("sheet2").Cells(k, 3) = Cells(i, j)
k = k + 1
End If
Next j
Next i
End Sub

回答No.3

for-you

関数、ではなく「オートフィルタ」を使うのはいかがでしょうか？
エクセル上の「データ」→「フィルタ」→「オートフィルタ」があります。
1行目の欄にカーソルがあるのを確認し、これをクリックすると、
各列毎の右側に黒三角▼が表示されます。
それをクリックして抽出するのはどうでしょうか？

例えば　サービス１の所で「オプション」を選び「０と等しくない」という条件を
　　　　入れると、サービス１に「０」以外の数字が入っているものだけが抽出されます。

それで閲覧だけならできますよ。
そこから、更に別の表を作成する場合は別のシートにコピーする必要がありますが。

補足

ありがとうございます。

ご指導頂いた通り、確かに「オートフィルタ」を利用すると、
各サービスの欲しい結果だけ表示させることができるのですが、

>それで閲覧だけならできますよ。
>そこから、更に別の表を作成する場合は別のシートにコピーする必要がありますが。

まさにそこで悩んでいるんです。(T_T)
サービス１、サービス２・・・と仮定した項目が１６個もあり、
しかも毎月発生する作業なので、できるだけ短時間で作業できるようにしたいと思っている次第です。

回答No.2

misatoanna

ごめんなさい。
結果の内容を勘違いしていました。

回答No.1

misatoanna

マクロを使わないとして、こんな手法ではいかがでしょうか。
1)データ範囲を選択します。(例＝B2:E100)
2)0を"完全に同一なセル"を指定して空白に一括置換します。
3)データ範囲を選択し、[編集]-[ジャンプ]-[セル選択] から、空白セルを指定します。
4)[編集]-[削除] から、右方向にシフトを指定して実行します。