エクセルの関数またはマクロにてご教授頂けますでしょうか。 画像のような生産スケジュールを別シートに下記のように関数かマクロで引っ張りたいです。

画像

Visual Basic | Excel195閲覧xmlns="http://www.w3.org/2000/svg">500

ベストアンサー

0

ThanksImg質問者からのお礼コメント

非常にわかりやすく助かりました!

お礼日時:6/23 8:20

その他の回答(4件)

0

まず表をCtrl +t でテーブル化。データのクエリ、テーブルからを選択。 パワークエリエディタが開くのでまずは不要な行列を削除。日付を「下にフィル」で埋めます。 品番、商品番号の列を選択し「その他の列のピボット解除」を選択。あとは並べたいようにソートして「保存して閉じる」。 取っつきにくいですがマクロより分かりやすいかと。 パワークエリで検索してみてください。

0

<ご参考>関数版になります。ローテクで長いです。Sheet1が参照先シートです。 A3=INDEX(Sheet1!$2:$2,,AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)),0),ROW(A1))) B3=IFERROR(INDIRECT(ADDRESS(--RIGHT(IFERROR(AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(A1)),""),3),1,,,"sheet1")),"") C3=IFERROR(INDIRECT(ADDRESS(--RIGHT(IFERROR(AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(A1)),""),3),2,,,"sheet1")),"") D3=IFERROR(INDIRECT(ADDRESS(--RIGHT(IFERROR(AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(A1)),""),3),INT(IFERROR(AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(A1)),"")),,,"sheet1")),"") A4=IF(B4="","",IF(INDEX(Sheet1!$2:$2,,AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)),0),ROW(A2)-COUNTBLANK($B$3:$B3)))=INDEX(Sheet1!$2:$2,,AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)),0),ROW(A2)-1-COUNTBLANK($B$3:$B3))),"",INDEX(Sheet1!$2:$2,,AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)),0),ROW(A2)-COUNTBLANK($B$3:$B3))))) B4=IFERROR(INDIRECT(ADDRESS(--RIGHT(IFERROR(IF(B3="",AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(A2)-COUNTBLANK($B$3:$B3)),IF(INT(AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(A2)-COUNTBLANK($B$3:$B3)))<>INT(AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(A2)-1-COUNTBLANK($B$3:$B3))),"",AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(A2)-COUNTBLANK($B$3:$B3)))),""),3),1,,,"sheet1")),"") C4=IFERROR(INDIRECT(ADDRESS(--RIGHT(IFERROR(IF(C3="",AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(A2)-COUNTBLANK($C$3:$C3)),IF(INT(AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(A2)-COUNTBLANK($C$3:$C3)))<>INT(AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(A2)-1-COUNTBLANK($C$3:$C3))),"",AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(A2)-COUNTBLANK($C$3:$C3)))),""),3),2,,,"sheet1")),"") D4=IFERROR(INDIRECT(ADDRESS(--RIGHT(IFERROR(IF(D3="",AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(D2)-COUNTBLANK($D$3:$D3)),IF(INT(AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(D2)-COUNTBLANK($D$3:$D3)))<>INT(AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(D2)-1-COUNTBLANK($D$3:$D3))),"",AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(D2)-COUNTBLANK($D$3:$D3)))),""),3),INT(IFERROR(IF(D3="",AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(D2)-COUNTBLANK($D$3:$D3)),IF(INT(AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(D2)-COUNTBLANK($D$3:$D3)))<>INT(AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(D2)-1-COUNTBLANK($D$3:$D3))),"",AGGREGATE(15,6,INDEX(1/(Sheet1!$D$3:$L$9>0)*(COLUMN(Sheet1!$D$3:$L$9)+TEXT(ROW(Sheet1!$D$3:$L$9)/1000,"0.000#")),0),ROW(D2)-COUNTBLANK($D$3:$D3)))),"")),,,"sheet1")),"") A4:D4を下へフィルコピー

回答文字数オーバーなので追記です。大変長いですが、同日日付だったら空白とか、日が変わったら1行空白にするといった部分が影響しています。単純に日付順に表示するだけなら、もっと簡素な数式になりなす。

0

日付の書式、数値の書式と添付図と同じように罫線も設定します。 Sub test() Dim I As Long, j As Long, r As Long, c As Long Dim D, k As Long, l As Long, cnt As Long, rng As Range With Sheets("予定") Set rng = .Range("A2:D2") c = .Cells(2, Columns.Count).End(xlToLeft).Column r = .Cells(Rows.Count, 1).End(xlUp).Row ReDim D(1 To (r + 1) * c, 1 To 4) k = 1 For j = 4 To c l = 0 cnt = Application.Count(.Cells(3, j).Resize(r - 2)) If cnt Then D(k, 1) = .Cells(2, j) For I = 3 To r If .Cells(I, j) <> "" Then D(k + l, 2) = .Cells(I, 1) D(k + l, 3) = .Cells(I, 2) D(k + l, 4) = .Cells(I, j) l = l + 1 End If Next k = k + l + 1 End If Next End With Sheets("集計").Select Range("A:D").Clear rng.Copy Range("A2") Range("A2:D2") = Array("", "品番", "商品名", "生産数") Range("A3").Resize(UBound(D), 4) = D r = Cells(Rows.Count, 4).End(xlUp).Row + 1 Range("A3:A" & r).NumberFormatLocal = "m月d日" Range("D3:D" & r).NumberFormat = "#,##0" Range("A2", Cells(r, 4)).Borders.LineStyle = True End Sub

0

行や列を追加した場合でも、変更する必要はありません。 品番が増えても、日付が増えても変更しなくてもよいです。 Sub sample() Dim I As Long, j As Long, k As Long Dim maxC As Long, maxR As Long, maxR2 As Long Dim ws As Worksheet '予定シートを表示する Sheets("予定").Activate '集計シートを「ws」で使用する Set ws = Sheets("集計") '予定シートの2行目の最終列(K列)を取得(6月8日) maxC = Cells(2, Columns.Count).End(xlToLeft).Column '集計シートのA列の最終行(11行目)を取得(6月4日) maxR = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row '予定シートのA列の最終行(9行目)を取得(7) maxR2 = Cells(ws.Rows.Count, "A").End(xlUp).Row '集計シートのA列の1行目から最終行(11行目)までループ For I = 1 To maxR '予定シートのD列から最終列(K列)までループ For j = 4 To maxC '【日付の照合】 '集計シートのA列i行目と予定シートのj列2行目が一致したら If ws.Cells(I, "A").Text = Cells(2, j).Text Then '予定シートのA列の3行目から最終行(9行目)までループ For k = 3 To maxR2 '予定シートのj列k行目が空白でなければ If Cells(k, j) <> "" Then '【B列に品番を書き込む】 '集計シートのB列i行目に予定シートのA列k行目の値を代入 ws.Cells(I, "B") = Cells(k, "A") '【C列に商品名を書き込む】 '集計シートのC列i行目に予定シートのB列k行目の値を代入 ws.Cells(I, "C") = Cells(k, "B") '【D列に生産数を書き込む】 '集計シートのD列i行目に予定シートのj列k行目の値を代入 ws.Cells(I, "D") = Cells(k, j) '【改行】 'iの値を+1する I = I + 1 End If Next End If Next Next '集計シートを表示する ws.Activate '集計シートへの参照を解除 Set ws = Nothing End Sub

ありがとうございます! こちらで使用できそうなのですが、1つだけ教えていただきたいです。 予定シートと集計シートの日付のセルですが、表示形式が違う(6/1や6月1日など・・・)場合、集計シートに反映できないマクロとなっているかと思います。 こちらどうにかして表示形式がことなっていても集計できるように修正できないでしょうか。。。 申し訳ございません、よろしくお願いします。