エクセルですべての一覧から、記入されたもののみ、情報を整理して自動リスト化する方法

以下のような配列で、自動リスト化できないかと考えています。

．　　　　　　　　11月1日|11月2日|11月3日　
食費|ご飯|にんじん|2　　　|1　　　 |
食費|ご飯|だいこん|　　　 |　　　　|1

↓

11月1日|食費|ご飯|にんじん|2
11月1日|食費|ご飯|だいこん|1

具体的には画像もご確認ください。
よろしくお願いいたします。

質問者からの補足コメント

• 私もこのフォーマットが正しいとは思っていませんが、以下のような状況をご理解ください。
  
  1)作成したいリスト（画像下部）が、提出する形式テンプレート
  2)現状、プルダウンリストから手入力で選択入力しているが、数十項目を選択形式は時間がかかっている。
  3)エクセルの使用レベルも違う複数人が使用しているため、「数字を入力するだけ」でリストが作成されるようにしたい。

  No.2の回答に寄せられた補足コメントです。 補足日時：2016/11/14 15:59

No.4 ベストアンサー 回答者： ママチャリ 回答日時： 2016/11/14 23:37

VBAだと、こんな感じになるのですが、理解できますか？

Sub sample()
Dim r As Range
Dim i As Long
Sheets("Sheet2").Cells.Delete
With Sheets("Sheet1")
For Each r In .Range(.Cells(2, "D"), .Cells.SpecialCells(xlCellTypeLastCell))
If r.Value <> "" Then
i = i + 1
.Cells(1, r.Column).Copy Destination:=Sheets("Sheet2").Cells(i, "A")
Sheets("Sheet2").Cells(i, "B") = .Cells(r.Row, "A")
Sheets("Sheet2").Cells(i, "C") = .Cells(r.Row, "B")
Sheets("Sheet2").Cells(i, "D") = .Cells(r.Row, "C")
Sheets("Sheet2").Cells(i, "E") = r.Value
End If
Next r
End With
End Sub

この回答へのお礼

具体的に状況を察していただいた回答者の方にベストアンサーしたいのは山々でしたが、実際に使用してみた結果、ママチャリさまの記述が一番私にはわかりやすく、自分なりのカスタムも容易でしたのでベストアンサーとさせていただきます。
ありがとうございました。

お礼日時：2016/11/15 19:33

No.5 回答者： WindFaller 回答日時： 2016/11/15 01:03

>このフォーマットが正しいとは思っていませんが、

それぞれの表は、営業部と経理部の考え方を反映するような種類のものだと思います。経理部なら、そのままのファイルを渡されても、リスト化をしてくれないと、困ってしまいます。

でも、営業部では、こちらがそこまでしたくない、ということで、営業補佐の事務管理する人が、やむなくするけれども、「もう嫌!」という切羽詰まってしまった状態! なんて想像してしまいました。（^^;

結果的は、VBAが作るほうとしては楽でしょうけれども、問題は、メインテナンスとそれが維持できるかどうか、不安が残るところです。
--それは、作る側が、いかに分かりやすいコードを書くか、という責任にもなりますが、残念ながら、この私の作るものは、たぶん、読めないコードになってしまいます。

採用する場合、自分でも読めると思えるようなコードを選べばよいです。ただし、出力方法とかちがっていたら、見送りでしょうけれど。（御託だけ並べてもしょうがないので、こちらも書きます。私なら、どう書くか？)

使う使わないは別として、マクロは一度は試してみるのも悪くはないと思います。1秒かそこらで、書き換えが終わってしまいます。
----------------------

Alt + F11 で、マクロ画面を開き、挿入(i)->標準モジュール
最後は、フォームボタンに登録してください。
'//貼り付けます。

Sub Spread2Listing()
''シートの登録
　Dim sh1 As Worksheet: Set sh1 = Worksheets("Sheet1")
　Dim sh2 As Worksheet: Set sh2 = Worksheets("Sheet2")
　
　''列の最後まで
　Dim j As Long, EndofMonth As Long
　EndofMonth = sh1.Cells(1, Columns.Count).End(xlToLeft).Column
　
　''行の最後まで
　Dim i As Long, EndofItem As Long
　EndofItem = sh1.Cells(Rows.Count, 1).End(xlUp).Row　'A列で最終行数を調べる
　Dim k As Long　行数
　Dim myDate As Variant　'日付
　
　With sh1
　　k = 2
　　For j = 4 To EndofMonth 'D列から
　　　myDate = sh1.Cells(1, j).Text
　　　　For i = 2 To EndofItem '2行目から
　　　　　If sh1.Cells(i, j).Value > 0 Then
　　　　　　sh2.Cells(k, 1).Value = myDate
　　　　　　sh2.Cells(k, 2).Resize(, 3).Value = sh1.Cells(i, 1).Resize(, 3).Value
　　　　　　sh2.Cells(k, 5).Value = sh1.Cells(i, j).Value
　　　　　　k = k + 1
　　　　　End If
　　　　Next i
　　　　i = 0
　　Next j
　End With
　MsgBox "出来上がり", vbInformation
End Sub
'//

No.3 回答者： d-q-t-p 回答日時： 2016/11/14 17:28

> 以下のような状況をご理解ください。

要望を繰り返しているだけで 手順を変更できない理由はないように
思います。「できるかどうか」でいえば マクロを組めばできますが
どうもあなたに VBAの知識があるとも思えません。

例えば「数字を入力したけど 間違えたので訂正した」場合はどうし
ますかね。既に入力されたリストを訂正しなくてはいけないのです
から 入力したものをただ末尾に追加すればいい という話ではなく
なります。

他にも「入力したら自動で並べ替えして欲しい」のように 使い始め
れば必ず「こうして欲しい」がどんどん出てきます。それをご自身
でメンテナンスできるでしょうか。何かある度に「ここを今度はこ
うして」と回答者に依頼するのでしょうか。

> エクセルの使用レベルも違う複数人が使用しているため
入力くらい きちんと指示すればできるようになります。「レベルが
低いから数字しか入力できない」なんてことはありません。何十個
もある項目を一覧表から探す方が よほど大変でしょう。

結局 一覧表に直接入力させるのは 入力する側にとっても大変なので
すから どうやったところでいずれ見直さざるを得なくなります。

この回答へのお礼

申し訳ありませんがあなたと議論する気はありませんので、長文お控えいただけますと幸いです。

お礼日時：2016/11/14 18:45

No.2 回答者： d-q-t-p 回答日時： 2016/11/14 12:51

どう考えても逆です。

リストから一覧表を作りましょう。
一覧表に直接入力したら初心者には扱えなくなります。

この回答へのお礼

私もこのフォーマットが正しいとは思っていませんが、以下のような状況をご理解ください。

1)作成したいリスト（画像下部）が、提出する形式テンプレート
2)現状、プルダウンリストから手入力で選択入力しているが、数十項目を選択形式は時間がかかっている。
3)エクセルの使用レベルも違う複数人が使用しているため、「数字を入力するだけ」でリストが作成されるようにしたい。

お礼日時：2016/11/14 15:59

No.1 回答者： GooUserラック 回答日時： 2016/11/14 12:44

① マクロ（ＶＢＡ）を使っても良いですか？

② リストはどこに作るのですか？別ブックですか？それとも別シートですか？

この回答へのお礼

①できれば使いたくありませんが、方法がそれしかないのならマクロでもOKです。
②別シートです。（Sheet1に一覧があるのであれば、Sheet2にリスト）

お礼日時：2016/11/14 15:59