横並びのデータを条件付きで縦に転記させたい

Question

仕入表に入力した内容を、在庫表に自動転記させたいと思っています。
その際画像のように色ごとに在庫数をわかるようにさせたいのです。
 商品コードと商品名は最初の行のみに表示させたいです。（見やすさ）
また、商品と商品の間に太線を入れたいのですが、これらは関数で行なうことは可能でしょうか？
もし可能であれば関数を教えて頂けると嬉しいです。画像では1つのシートですが実際は仕入れ表と在庫表は別シートです。
よろしくお願いします。

tom04 · Accepted Answer

＞在庫表のA列B列C列を空白（こちらで手入力用）、D列に日付を追加したいのです・・・
↓のような配置になっているという前提です。

①　「仕入表」SheetのA列はシリアル値ですべての行に日付が入っている
②　「在庫表」SheetのA～C列には手を付けない
③　「在庫表」SheetのD列（日付列）は「仕入表」Sheetの1行分だけの日付しか表示させない。

Sub Sample4() '//この行から
Dim i As Long, j As Long, cnt As Long, lastRow As Long, wS As Worksheet
 Set wS = Worksheets("仕入表")
With Worksheets("在庫表")
'//E列で「在庫表」Sheetの最終行取得★
lastRow = .Cells(Rows.Count, "E").End(xlUp).Row
'//「在庫表」SheetにデータがあればD列2行目～I列最終行データを一旦消去
 If lastRow > 1 Then
 Range(.Cells(2, "D"), .Cells(lastRow, "I")).ClearContents
 End If
 cnt = 1
 For i = 3 To wS.Cells(Rows.Count, "A").End(xlUp).Row   '//「仕入表」Sheetの3行目～A列最終行まで
 For j = 5 To wS.Cells(i, Columns.Count).End(xlToLeft).Column Step 2    '//E列～i行最終列まで2行毎★
 If wS.Cells(i, j) <> 0 Then '//画像で「0」が表示されているので「0」以外を追加★
 cnt = cnt + 1
    '//最初のデータ行のみ「仕入表」Sheetの日付をD列に表示★
    If j = 5 Then
        .Cells(cnt, "D") = wS.Cells(i, "A")
    End If
    .Cells(cnt, "E") = wS.Cells(i, "B") '//B列に「コード」を表示
    .Cells(cnt, "F") = wS.Cells(i, "C") '//F列に「商品名」を表示
    .Cells(cnt, "G") = wS.Cells(i, "D") '//G列に「下代」を表示
    .Cells(cnt, "H") = wS.Cells(i, j)   '//H列に「色」を表示
    .Cells(cnt, "I") = wS.Cells(i, j + 1)   '//I列に「数」を表示
 End If
 Next j
 Next i
    '//最後にD列の表示形式（日付）を「在庫表」SheetのA3セルの書式に設定★
    .Range("D:D").NumberFormatLocal = wS.Range("A3").NumberFormatLocal
 End With
 End Sub '//この行まで

※　「日付」もすべての行に表示したい場合は、コード内の

＞ If j = 5 Then
＞.Cells(cnt, "D") = wS.Cells(i, "A")
＞End If
の3行を

＞.Cells(cnt, "D") = wS.Cells(i, "A")
の1行だけに変更してください。

今度はどうでしょうか？m(_ _)m

tom04 · Answer

こんにちは！

何とか関数で！とやりかけてみましたが結構面倒そうなので、
手っ取り早くお望みでないVBAでの一例です。

元データのSheet名が「仕入表」、表示させたいSheet名が「在庫表」となっていて
配置は↓の画像のようになっているとします。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト　→　Excel画面に戻り（VBE画面を閉じて）マクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1()   '//この行から
    Dim i As Long, j As Long, cnt As Long, lastRow As Long
    Dim c As Range, r As Range, wS As Worksheet
    Set wS = Worksheets("仕入表")
    With Worksheets("在庫表")
        lastRow = .Cells(Rows.Count, "C").End(xlUp).Row
        If lastRow > 1 Then
            Range(.Cells(2, "A"), .Cells(lastRow, "D")).ClearContents
        End If
        cnt = 1
            For i = 3 To wS.Cells(Rows.Count, "A").End(xlUp).Row
            For j = 3 To wS.Cells(i, Columns.Count).End(xlToLeft).Column Step 2
                cnt = cnt + 1
                Set c = .Range("A:A").Find(what:=wS.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
                    If c Is Nothing Then
                        .Cells(cnt, "A") = wS.Cells(i, "A")
                    End If
                Set r = .Range("B:B").Find(what:=wS.Cells(i, "B"), LookIn:=xlValues, lookat:=xlWhole)
                    If r Is Nothing Then
                        .Cells(cnt, "B") = wS.Cells(i, "B")
                    End If
                .Cells(cnt, "C") = wS.Cells(i, j)
                .Cells(cnt, "D") = wS.Cells(i, j + 1)
            Next j
            Next i
    End With
End Sub '//この行まで

※　関数でないのでデータ変更があるたびにマクロを実行する必要があります。

一つ気になるのが、「在庫表」というコトですので
元々在庫があるものも仕入れることがあるはずです。
その場合は「在庫数」＋「仕入数」と考えるのが普通だと思いますが
その辺は考慮していません。m(_ _)m

tom04 · Answer

No.1です。

補足に色々書いてありますが、おそらくVBAで可能だと思います。
ただ、具体的にどんな配置でどんなデータが入っているのか判らないので
今すぐに的確なアドバイスはできません。
VBAの場合（関数でも同様ですが）1列・1行違っただけで全く意図しない動きになってしまいます。
少しのサンプルでも判れば少しはお役に立てると思います。

＞コードもA～E行にわかれて入力し・・・
＞コードはA143-C118S1Sのような形です。

云々とありますが、知りたいのはどのようなデータがどんな配置になっているか？
というコトです。

直接の回答ではありませんが、
まずはこの程度でごめんなさい。m(_ _)m

tom04 · Answer

続けてお邪魔します。

＞ちなみに在庫表は隣のタブでないとVBAは無理ですか
コード内にSheet名を指定していますので、「仕入表」Sheetも「在庫表」SheetもSheet見出しのどの位置にあっても構いません。

＞コードはA143-C118S1Sのような形です。
とありますが、ハイフンまでがひとまとまりのコードという意味ではないですよね？
コード全体が一つのまとまりとすると、前回のコードに少し手を加えるだけで大丈夫です。
↓のコードに変更してマクロを実行してみてください。
（操作方法はNo.1で書いた通りです）

Sub Sample2() '//この行から
Dim i As Long, j As Long, cnt As Long, lastRow As Long
 Dim c As Range, r As Range, wS As Worksheet
 Set wS = Worksheets("仕入表")
With Worksheets("在庫表")
lastRow = .Cells(Rows.Count, "C").End(xlUp).Row
 If lastRow > 1 Then
 Range(.Cells(2, "A"), .Cells(lastRow, "D")).ClearContents
 End If
 cnt = 1
 For i = 3 To wS.Cells(Rows.Count, "A").End(xlUp).Row   '//「仕入表」Sheetの3行目～A列最終行まで
 For j = 4 To wS.Cells(i, Columns.Count).End(xlToLeft).Column Step 2    '//D列～i行最終列まで2行毎★
 If wS.Cells(i, j) <> 0 Then '//画像で「0」が表示されているので「0」以外を追加★
 cnt = cnt + 1
    Set c = .Range("A:A").Find(what:=wS.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
 If c Is Nothing Then
 .Cells(cnt, "A") = wS.Cells(i, "A")
 End If
 Set r = .Range("B:B").Find(what:=wS.Cells(i, "B"), LookIn:=xlValues, lookat:=xlWhole)
 If r Is Nothing Then
 .Cells(cnt, "B") = wS.Cells(i, "B")
 End If
 .Cells(cnt, "C") = wS.Cells(i, j)
 .Cells(cnt, "D") = wS.Cells(i, j + 1)
 End If '//★
 Next j
 Next i
 End With
 End Sub '//この行まで

※　変更部分に「★」のマークを入れています。

こんなんではどうでしょうか？m(_ _)m

MarcoRossiItaly · Answer

Excel の使い方がいろいろ違います。添付図の数式は次のとおり。

Sheet2
I4　=vlookup($H4,sheet1!$A:$D,2,)
J4　=vlookup($H4,sheet1!$A:$D,3,)
K4　=vlookup($H4,sheet1!$A:$D,4,)

Sheet3
P4　=index(sheet1!b:b,match(o4,sheet1!$D:$D,))
R4　=sumifs(sheet2!$L:$L,sheet2!$G:$G,$O$1,sheet2!$I:$I,$P4,sheet2!$J:$J,q4)

ゼロを見せたくない場合は、セルの書式「#,##0;;」などでゼロのみ非表示にしてください。

質問文にある「在庫表」が欲しい場合は、Sheet2 から、「ピボットテーブル」の機能により類似の書式の表を作ってください。

それでも満足できない場合は、No.1 さんのように VBA で力ずくで処理するため、時間をかけてコードを書かざるを得ません。Word のような使い方をしていると、独特な表の書式に合わせるのがたいへんで、コードを書くのも苦労します。

tom04 · Answer

No.1～3です。
補足の
＞（下代含め）
を見逃していました。
「在庫表」Sheetに「下代」も表示させたい！という意味でしょうか？

そうであれば表示させたい列が判れば、少し手を加えれば対応できます。m(_ _)m

tom04 · Answer

続けてお邪魔します。

＞在庫表のC列に下代を入れたいです
と
＞在庫表に転記された商品名は全て入力することは可能ですか
というコトですので・・・

これならもっと簡単なコードで済みます。
↓の画像のように左側が「仕入表」Sheet・右側が「在庫表」Sheetとします。
今までのコードはすべて消去し、↓のコードに変更してみてください。

Sub Sample3() '//この行から
Dim i As Long, j As Long, cnt As Long, lastRow As Long, wS As Worksheet
 Set wS = Worksheets("仕入表")
With Worksheets("在庫表")
lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
 If lastRow > 1 Then
 Range(.Cells(2, "A"), .Cells(lastRow, "D")).ClearContents
 End If
 cnt = 1
 For i = 3 To wS.Cells(Rows.Count, "A").End(xlUp).Row   '//「仕入表」Sheetの3行目～A列最終行まで
 For j = 4 To wS.Cells(i, Columns.Count).End(xlToLeft).Column Step 2    '//D列～i行最終列まで2行毎★
 If wS.Cells(i, j) <> 0 Then '//画像で「0」が表示されているので「0」以外を追加★
 cnt = cnt + 1
  If j = 4 Then
    .Cells(cnt, "A") = wS.Cells(i, "A")
End If
    .Cells(cnt, "B") = wS.Cells(i, "B")
    .Cells(cnt, "C") = wS.Cells(i, "C")
    .Cells(cnt, "D") = wS.Cells(i, j)
    .Cells(cnt, "E") = wS.Cells(i, j + 1)
 End If '//★
 Next j
 Next i
 End With
 End Sub '//この行まで

これではどうでしょうか？m(_ _)m

tom04 · Answer

何度もごめんなさい。
前回のコードのコメントで間違いがありました。
（コードそのものは問題ないと思います）

＞'//B列に「コード」を表示
は
＞E列に・・・
が正解です。m(_ _)m

横並びのデータを条件付きで縦に転記させたい

こんにちは！

No.1です。

続けてお邪魔します。

Excel の使い方がいろいろ違います。

No.1～3です。

続けてお邪魔します。

＞在庫表のA列B列C列を空白（こちらで手入力用）、D列に日付を追加したいのです・・・

何度もごめんなさい。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング