[[20150416154909]]　『【VBA】商品毎の管理表を作成したい』（みや）　ページの最後に飛ぶ

『【VBA】商品毎の管理表を作成したい』（みや）

シート１（管理表）で商品の発注状況と回答納期、数量、管理番号を管理したい。

シートの構成は下記のとおり。

シート１・・・管理表（列はＹ列まで）
Ａ～Ｃ列と１～２行は見出しで使用しています（固定）

Ｄ４・・・商品名
Ｊ３～Ｙ３・・・希望納期
Ｊ４～Ｙ４・・・希望納期の注文数
Ｊ５～Ｙ５・・・希望納期の管理番号
Ｊ６～Ｙ６・・・回答納期
の３行で１商品に対して構成しています。

同様に
Ｄ７・・・商品名
Ｊ７～Ｙ７・・・希望納期の注文数
Ｊ８～Ｙ８・・・希望納期の管理番号
Ｊ９～Ｙ９・・・回答納期

Ｄ１０、Ｄ１３・・・と３行単位で現状Ｄ４０まで商品名あり

シート２・・・・発注データ（１行目は項目で２行目以降がデータ）
行は日々変化します（ＭＡＸ１０００行）

シート２でシート１（管理表）にデータを引用したい列は

Ｆ列・・・管理番号
Ｈ列・・・商品名
Ｊ列・・・希望納期
Ｋ列・・・回答納期
Ｌ列・・・数量

同一希望納期で同一商品名はないものとします。

検索順としては商品名⇒希望納期⇒管理番号⇒回答納期⇒数量（重複がないので検索順は変更可能）

複数条件の検索がうまくできず、暗礁に乗り上げてしまいました。

どなたか教えてください。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

管理番号の検索結果（セル）から各値を求めるとしたら、こんな感じでしょうか。

 　
管理番号検索：c
商品名は２行上のD列：c.offset(-2).entirerow.cells(4).value
希望納期は３行目：c.entirecolumn.cells(3).value
回答納期は１行下：c.offset(1).value
数量は１行上：c.offset(-1).value

（マナ） 2015/04/16(木) 22:34

↑シート１とシート２を逆に考えていました。
無視ししてください。

（マナ） 2015/04/16(木) 23:41

 >検索順としては商品名⇒希望納期⇒管理番号⇒回答納期⇒数量

 ん？

 検索は　商品名⇒希望納期⇒管理番号　で、そこに　回答納期と数量を転記するのでは？

 さらにいえば、希望納期の管理番号ということですが、１つの商品で見た場合、希望納期　と　管理番号は　１：１　ですか？
 それとも　１：複数　ですか？　それとも　複数：１　ですか？　はたまた　複数：複数ですか？

 別の言い方をすれば、商品名⇒希望納期　または　商品名⇒管理番号　この検索だけでは不都合ですか？

（β） 2015/04/17(金) 06:54

 独断で、検索は　商品名⇒希望納期、マッチした場所に管理番号、回答納期、数量　を転記。

 Sub Test()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim dateR As Range
    Dim comR As Range
    Dim c As Range
    Dim i As Variant
    Dim j As Variant
    Dim x As Long
    Dim w As Variant

    Set sh1 = Sheets("管理表")
    Set sh2 = Sheets("発注データ")

    With sh1.Range("A1", sh1.UsedRange)
        Set dateR = .Rows(3).Resize(, .Columns.Count - 7).Offset(, 7)
        Set comR = .Columns("D").Resize(.Rows.Count - 2).Offset(2)
    End With

    With sh2.Range("H2", sh2.Range("H" & Rows.Count).End(xlUp))
        ReDim w(1 To .Rows.Count)
        For Each c In .Cells
            i = Application.Match(c, comR, 0)
            j = Application.Match(c.Offset(, 2), dateR, 0)
            If IsNumeric(i) And IsNumeric(j) Then
                With sh1.Cells(comR.Row + i - 1, dateR.Column + j - 1)
                    .Value = c.EntireRow.Range("L1").Value
                    .Offset(1).Value = c.EntireRow.Range("F1").Value
                    .Offset(2).Value = c.EntireRow.Range("K1").Value
                End With
            Else
                x = x + 1
                w(x) = c.Value & "-" & c.Offset(, 2).Text
            End If
        Next

        If x > 0 Then
            ReDim Preserve w(1 To x)
            MsgBox "以下のデータの反映ができません" & vbLf & Join(w, vbLf)
        End If
    End With

 End Sub

（β） 2015/04/17(金) 07:44

マナさん、βさん

ありがとうございます。
βさんのマクロでバッチリでしたｍ（＿　＿）ｍ
（みや） 2015/04/17(金) 13:48

コメント返信：

[ 一覧(最新更新順) ]

[[20150416154909]] 『【VBA】商品毎の管理表を作成したい』（みや） ページの最後に飛ぶ

[[20150416154909]]　『【VBA】商品毎の管理表を作成したい』（みや）　ページの最後に飛ぶ