エクセルで横並びの複数データを縦のデータにしたい こんにちは。宜しくお願い致します。 A B C D

エクセルで横並びの複数データを縦のデータにしたい

こんにちは。宜しくお願い致します。

　　　A B C D E F
1　生食　　1　 本　あめ　 2 　個
2　　玉　　2 個　いか　 1 本
3　あめ　　1 個　パン　 1 枚


例えばこういう形であったとします。
これを別のシート（同じシートの違う場所でも構いません）に縦並びで出したいときどうしたらいいでしょうか。

★こういう風にしたい★

　　A B C
1　生食　　1　 本　
2　　玉　　2 個
3　あめ　　1 個　
4　あめ　 2 　個
5　いか　 1 本
6　パン　 1 枚

※重複していても構いません。
データ量が多く、コピーペーストではしんどいです。また、横データも同じ感じであと５つ位あるので。


宜しくお願い致します。

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

• VBAで出来たら、早いような気がします！よろしくお願いします！

    補足日時：2020/04/18 11:35

• 複雑な業務をしているので教えていただきたいのですが、A〜Fのモジュールと比較するために同じようにG〜Iを追加するとモジュールはどうなるでしょうか。よろしくお願いします。

    補足日時：2020/04/18 16:55

• 同じような操作を3列おきに行えば良い！そのとおりです！
  項目行がありますのでよろしくお願いします。2行目からのコピー＆ペーストでお願いします。3列おきに行うやり方も教えて下さい！

    補足日時：2020/04/18 20:12

• Sheet2も1行目が項目行だとして変更してみました。
  ↓
  
  Shee1の1行目の最初の3列がSheet2の項目行なのですが表示されません！　
  よろしくお願いします！

    補足日時：2020/04/18 22:32

• 前回に頂いていたコードと今回のコードを合わせて編集するとできましたが、for next でlastLowを設定したほうが "A"列の行数より"D"列の行数が多い場合に良さそうです。なので最初にsheet1をsheet2にコピーしてからsheet2の2行目以降をclearContentsするのではなく、最初からsheet1の項目行だけをコピーするやり方が良さそうです。長々とご教授いただきまして有難うございました。できれば、この部分のコードも分かればお願いします。いい勉強になりました。

    補足日時：2020/04/18 23:51

No.7 ベストアンサー 回答者： tom04 回答日時： 2020/04/18 20:28

No.1・3・6です。

＞2行目からのコピー＆ペーストで・・・
前回のコードを少し変更するだけです。
尚、Sheet1の1行目項目は最終列まで入っているという前提です。
（1行目で最終列を取得しているため）

Sub Sample3()
　Dim j As Long, lastRow As Long
　Dim wS As Worksheet
　　Set wS = Worksheets("Sheet2")
　　　'//▼Sheet2の2行目以降を消去//
　　　lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
　　　　If lastRow > 1 Then
　　　　　Range(wS.Cells(2, "A"), wS.Cells(lastRow, "C")).ClearContents
　　　　End If
　　　　'//▼ココから操作//
　　　　With Worksheets("Sheet1")
　　　　　For j = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column Step 3
　　　　　　lastRow = .Cells(Rows.Count, j).End(xlUp).Row
　　　　　　　Range(.Cells(2, j), .Cells(lastRow, j + 2)).Copy wS.Cells(Rows.Count, "A").End(xlUp).Offset(1) '//★//
　　　　　Next j
　　　　End With
　　　　　wS.Activate
　　　　　MsgBox "完了"
End Sub

※　本来であれば、「★」の行で前回は「1」になっているところを「2」に変更するだけでよいと思うのですが、
Sheet2も1行目が項目行だとして変更してみました。m(_ _)m

No.9 回答者： つぼだい 回答日時： 2020/04/18 23:43

No5です。

よく確かめずに的外れな回答をして申し訳ありません。
言い訳になりますが、例示のようなデータ配列をどのように活用していたのかが想定できません。
余計なお世話かもしれませんが、やりたいことの目的は出来上がったデータをデーターベースのテーブルデータとして読み込みたいのかと想像しました。だどすれば、ややこしいことは考えずにそのまま取り込んで、必要な列の組だけのテーブルをいくつか作成し、追加クエリを何回か実行すれば出来上がります。目的がデータベースでなくても、このテーブルをテキストで吐き出せは結果は同じものが得られます。
あくまで、余計なお世話ですが。

No.8 回答者： tom04 回答日時： 2020/04/18 23:19

No.7で記載していますが・・・

＞尚、Sheet1の1行目項目は最終列まで入っているという前提です。
＞（1行目で最終列を取得しているため）

の部分です。
Sheet1の1行目で最終列を取得するようにしていますので、
Sheet1に1行目は最終列まで何らかのデータがないとデータがある列まででループが止まってしまいます。

※　VBAに関しては、ごく初歩的なコードで投稿したのですが、
ご自身で手直しできないのであれば、
No.1で投稿したような方法で、コツコツ手作業で操作した方が無難だと思います。m(_ _)m

No.6 回答者： tom04 回答日時： 2020/04/18 18:28

No.1・3です。

＞複雑な業務をしているので・・・
とありますが、文章だけではどのようなコトをしたいのかが不明です。

＞A〜Fのモジュールと比較するために同じようにG〜Iを追加すると・・・
同じような操作を3列おきに行えば良い！というコトでしょうかね？

本来であればビフォー＆アフターの画像などを添付してもらうのが一番わかりやすいのですが、
とりあえず上記のようなコトだとしてのコードです。

Sub Sample2()
　Dim j As Long, lastRow As Long
　Dim wS As Worksheet
　　Set wS = Worksheets("Sheet2")
　　　wS.Range("A:C").ClearContents
　　　　With Worksheets("Sheet1")
　　　　　For j = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column Step 3
　　　　　　lastRow = .Cells(Rows.Count, j).End(xlUp).Row
　　　　　　　Range(.Cells(1, j), .Cells(lastRow, j + 2)).Copy wS.Cells(Rows.Count, "A").End(xlUp).Offset(1)
　　　　　Next j
　　　　End With
　　　　　wS.Range("A1:C1").Delete
　　　　　wS.Activate
　　　　　MsgBox "完了"
End Sub

※　一般的には項目行があると思うのですが、
最初の質問文通り1行目からのコピー＆ペーストとしています。m(_ _)m

No.5 回答者： つぼだい 回答日時： 2020/04/18 14:35

単純にこの例だけでよいのなら、範囲をコピーして、貼り付けの際に行列を入れ替えれば一発です。

No.4 回答者： Fuego_7538 回答日時： 2020/04/18 11:57

VBAでプログラムを記述してロードさせるより、マウス操作で地道に処理した方が早いと思いますが・・・データーがきれいに配列されれば、その後はマクロなりVBAで思う存分好きなように処理できます。

其の素地を作成にするのにプログラムを記述・エラーチェックする時間があれば、マウス操作によるアナログ処理の方が効率的のような気がしますけどね・・・それと根本的にVBAは不慣れなので的確なお答えができません。

No.3 回答者： tom04 回答日時： 2020/04/18 11:54

No.1です。

＞VBAで出来たら、早いような気がします！

前回回答した操作をそのままコードにしてみました。
（Sheet1のデータをSheet2に！）

標準モジュールにしてください。

Sub Sample1()
　Dim lastRow As Long
　Dim wS As Worksheet
　　Set wS = Worksheets("Sheet2")
　　　wS.Range("A:C").ClearContents
　　　　With Worksheets("Sheet1")
　　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　　Range(.Cells(1, "A"), .Cells(lastRow, "C")).Copy wS.Range("A1")
　　　　　　Range(.Cells(1, "D"), .Cells(lastRow, "F")).Copy wS.Cells(Rows.Count, "A").End(xlUp).Offset(1)
　　　　End With
　　　wS.Activate
　　　MsgBox "完了"
End Sub

こんな感じではどうでしょうか？m(_ _)m

No.2 回答者： Fuego_7538 回答日時： 2020/04/18 09:38

順不同で縦配列にしたいのなら

まずは配列後に抽出や並び替えをしやすいように項目ごとにナンバリングします。ナンバリングの列を含め各データは１つセルに１つだけにして列項目ごとに縦揃えにします。

ナンバリングの方法は
1～3の縦並びにした番号列を基準に１にマウスカーソルを置いて左ボタンを押したまま３までを指定すると、指定した部分だけハイライト表示と共に枠が表示されます。枠の右隅にカーソルを置き、マウスの左ボタンを押したっままでに任意の場所の行数まで下にスクロールすると自動で4以下の数字でナンバリングできます。

後は列項目ごとを一括で「切り取り」「貼り付け」を繰り返せば、セルデータ１個単位で移動させるより効率が上がると思います。

No.1 回答者： tom04 回答日時： 2020/04/18 08:48

こんにちは！

元データはお示しのようにA～F列までのデータなのですね。
一番簡単な方法として・・・
元データはSheet1にあり、Sheet2にコピー＆ペーストするとします。

A1～C1セルを選択　→　Ctrl＋Shiftを押しながら「↓」（下向き矢印）を押す　→　A～C列の最終行までが選択されますので
右クリック　→　コピー　→　Sheet2のA1セルに貼り付け

同様にD1～F1セルを選択　→　・・・中略・・・　→　Sheet2のA列最終行の1行下を選択
（A列を選択　→　Ctrl＋「↓」で最終行が選択されるのでその下の行を選択）　→　貼り付け！

コツコツ手を動かすのが一番簡単だと思います。m(_ _)m