エクセルマクロの組み方

マクロ初心者です。
表のデータの並べ替え方について質問です。

例として、A列に日付、B列に発注番号、C列に品名①、D列に品目①の数量、E列に品名②、F列に品目②の数量を設定している表があるとします。

この表を、品目・数量①と②が横並び（C~Fの４列）になっているところを、縦並び2行（C,D列×2行）にしてそれぞれに日付と発注番号を表示させるにはどのようにすればよいのでしょうか。

よろしくお願いします。

No.8 回答者： tom04 回答日時： 2018/01/05 13:33

No.5・6です。

＞「会社名」や「請求番号」もSheet2に表示したい、ということです。

どの列に表示したいのかを具体的に提示してもらってないので、勝手に↓の画像のような配置でやってみました。
前回のコードはすべて消去し、↓のコードにしてみてください。

Sub Sample2()
Dim i As Long, j As Long, cnt As Long, wS As Worksheet
Set wS = Worksheets("Sheet1")
With Worksheets("Sheet2")
'//▼Sheet2のデータクリア　→　項目名表示//
.Range("A:F").Clear
.Range("A1:B1").Value = wS.Range("A1:B1").Value
.Range("C1") = "品名"
.Range("D1") = "数量"
.Range("E1:F1").Value = wS.Range("I1:J11").Value
.Range("A:A").NumberFormatLocal = wS.Range("A2").NumberFormatLocal
'//▼ここから処理//
cnt = 1
For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
For j = 3 To 7 Step 2 '//C～G列まで、1列おき//
If wS.Cells(i, j) <> "" Then
cnt = cnt + 1
With .Cells(cnt, "A")
.Value = wS.Cells(i, "A")
.Offset(, 1) = wS.Cells(i, "B")
.Offset(, 2) = wS.Cells(i, j)
.Offset(, 3) = wS.Cells(i, j + 1)
.Offset(, 4) = wS.Cells(i, "I")
.Offset(, 5) = wS.Cells(i, "J")
End With
End If
Next j
Next i
.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
.Activate
End With
MsgBox "完了"
End Sub

これで画像のような感じでSheet1のがSheet2に表示されます。m(_ _)m

この回答へのお礼

うまくいきました！
助かりました。ありがとうございました。

お礼日時：2018/01/05 16:18

No.7 回答者： めぐみん_ 回答日時： 2018/01/05 11:53

No.3です。

既に目的に近い回答も出ているようですし、また更に条件が足されるようですので、細かい修正をしてもらっては如何でしょう。
ただ、
＞I ,Jの項目行に会社名（I)と請求番号(J)の列がある場合は、どこにどのような式を足せばよいでしょうか？

どこにどのようにしたいのかを質問されている側で決めて頂かないとね。
それにI,Jは常に会社名と請求番号なのか、或いは品名と数量の変動によって列が変わるのかで違いは出ますよ。

この回答へのお礼

回答ありがとうございました。
I,Jは常に会社名と請求番号です。

お礼日時：2018/01/05 11:57

No.6 回答者： tom04 回答日時： 2018/01/05 11:44

No.5です。

＞I ,Jの項目行に会社名（I)と請求番号(J)の列がある場合は、どこにどのような式を足せばよいでしょうか？

「会社名」や「請求番号」もSheet2に表示したい！というコトでしょうか？
それともI列以降は無視して、対象範囲の列はH列まで！という意味なのでしょうか？

どの項目を表示したいかが判らないので、こちらにで勝手に判断してコードを記載しても意味がないように思えます。

その辺が具体的に判ればすこしはお役にたてるかもしれません。
回答でなくてごめんなさい。m(_ _)m

この回答へのお礼

回答ありがとうございます。
「会社名」や「請求番号」もSheet2に表示したい、ということです。
わかりにくくてすみません。

お礼日時：2018/01/05 11:55

No.5 回答者： tom04 回答日時： 2018/01/04 20:31

こんばんは！

横からお邪魔します。
↓の画像のような配置で元データはSheet1にあり、Sheet2に表示するようにしてみました。
尚、Sheet1の1行目は項目行になっているとします。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, j As Long, cnt As Long, wS As Worksheet
Set wS = Worksheets("Sheet1")
With Worksheets("Sheet2")
.Range("A:D").Clear
.Range("A1:B1").Value = wS.Range("A1:B1").Value
.Range("C1") = "品名"
.Range("D1") = "数量"
.Range("A:A").NumberFormatLocal = wS.Range("A2").NumberFormatLocal
cnt = 1
For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
For j = 3 To wS.Cells(i, Columns.Count).End(xlToLeft).Column Step 2
If wS.Cells(i, j) <> "" Then
cnt = cnt + 1
With .Cells(cnt, "A")
.Value = wS.Cells(i, "A")
.Offset(, 1) = wS.Cells(i, "B")
.Offset(, 2) = wS.Cells(i, j)
.Offset(, 3) = wS.Cells(i, j + 1)
End With
End If
Next j
Next i
.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
.Activate
End With
MsgBox "完了"
End Sub

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

この回答へのお礼

わかりやすい回答をありがとうございます！
I ,Jの項目行に会社名（I)と請求番号(J)の列がある場合は、どこにどのような式を足せばよいでしょうか？

お礼日時：2018/01/05 10:53

No.4 回答者： hallo-2007 回答日時： 2018/01/04 18:19

納品書、請求書の類ですかね。

別シートに表示さえるわけですよね。
関数で出来ると思いますが・・・
データ元の構成も
　A　　B　　　　C　　D
日付　発注番号　品名　数量
にして、
複数の品名の場合は、同じ発注番号でデータを持つようにした方が良いです。

この回答へのお礼

アドバイスありがとうございます！

お礼日時：2018/01/05 10:53

No.3 回答者： めぐみん_ 回答日時： 2018/01/04 15:15

No.2のお礼に対して。

＞セルにデータがない場合
とは、どこのセルを指す物なのでしょうか？

＞品目がもっと多い場合は、ForとNextの間を繰り返せばうまくいきますか？
＞また、品目の右側にもデータが続いていてA,B列と同じようにコピーしたい場合
シートの情報（セル範囲）が良くわかりません。
多分２列が１組になっているのだろうとは予測できますが、元のデータが全て同じ列数なのか行によって違うのか。
C列より右で途中に空白になる組があると言う事なのか、或いはC・D列が空白になっていると言う事なのか。

どうやるべきかは、どのようになっているかでも違ってきますし。

この回答へのお礼

回答ありがとうございます。

＞セルにデータがない場合
⇒品目が１つしかないなどの場合です。
（品目①の品目名と数量のデータはあるが、品目②のデータは空。⇒C,D列のセルにデータあり、E、F列のセルにデータなし）

＞シートの情報（セル範囲）が良くわかりません。
多分２列が１組になっているのだろうとは予測できますが、元のデータが全て同じ列数なのか行によって違うのか。
⇒最初横1行だったデータを品目数分の行に増やしたいです。例えば品目数が２つだったら2行にして、それぞれの品目ごとに他の全ての情報をもつようにしたいです（日付、発注番号など）。
最低１つは品目名が入るので、C,D列が空白になることはないです。

お礼日時：2018/01/05 11:06

No.2 回答者： めぐみん_ 回答日時： 2018/01/04 13:27

１行目は項目行でありデータは２行目から始まっているなら、

Sub try()
Dim lastRow As Long
Dim i As Long

lastRow = Cells(Rows.Count, "C").End(xlUp).Row

For i = lastRow To 2 Step -1
Rows(i + 1).Insert
Cells(i, "C").Range("C1:D1").Cut Cells(i, "C").Range("A2:B2")
Cells(i, "C").Offset(1, -2).Resize(, 2).Value = Cells(i, "C").Offset(, -2).Resize(, 2).Value
Next

Range("E1:F1").ClearContents

End Sub

－－－－

１行目からデータが始まっていて項目行は存在しないなら

Sub try2()
Dim lastRow As Long
Dim i As Long

lastRow = Cells(Rows.Count, "C").End(xlUp).Row

For i = lastRow To 1 Step -1
Rows(i + 1).Insert
Cells(i, "C").Range("C1:D1").Cut Cells(i, "C").Range("A2:B2")
Cells(i, "C").Offset(1, -2).Resize(, 2).Value = Cells(i, "C").Offset(, -2).Resize(, 2).Value
Next

End Sub

－－－－－

こんな感じで如何でしょうか。

この回答へのお礼

早速の回答ありがとうございます。
うまくいきました！！

セルにデータがない場合はその行を非表示（挿入を行わない）にすることは可能でしょうか？
品目がもっと多い場合は、ForとNextの間を繰り返せばうまくいきますか？
また、品目の右側にもデータが続いていてA,B列と同じようにコピーしたい場合は、
どのようにすればよいでしょうか？

もしお時間あればよろしくお願いします！

お礼日時：2018/01/04 14:31

No.1 回答者： めぐみん_ 回答日時： 2018/01/04 12:59

例としてあげるのならBefore・Afterを提示されると回答者は分かり易いですけどね。

元が１行で横並びの物を、縦並び2行（C,D列×2行）にした時、A・B列はどうなるの？と言う疑問が出てきますので。
まさか１行だけしかデータがない訳ではないでしょうし、A・B列を
・１行追加してE・F列のデータをC・D列に移動し、A・B列は空白
・上記作業をして、A・B列は上のデータを複写
・上記作業をして、A・B列はそれぞれ縦に『セルの結合』
とかを視覚化で訴えてみるのが確実かもですよ。

この回答へのお礼

ありがとうございます。行いたいのは以下です。

①１行追加してE・F列のデータをC・D列に移動
②上記作業をして、A・B列は上のデータを複写

よろしくお願い致します。

お礼日時：2018/01/04 13:18