[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『【VBA】商品毎の管理表を作成したい』(みや)
シート1(管理表)で商品の発注状況と回答納期、数量、管理番号を管理したい。
シートの構成は下記のとおり。
シート1・・・管理表(列はY列まで)
A〜C列と1〜2行は見出しで使用しています(固定)
D4・・・商品名
J3〜Y3・・・希望納期
J4〜Y4・・・希望納期の注文数
J5〜Y5・・・希望納期の管理番号
J6〜Y6・・・回答納期
の3行で1商品に対して構成しています。
同様に
D7・・・商品名
J7〜Y7・・・希望納期の注文数
J8〜Y8・・・希望納期の管理番号
J9〜Y9・・・回答納期
D10、D13・・・と3行単位で現状D40まで商品名あり
シート2・・・・発注データ(1行目は項目で2行目以降がデータ)
行は日々変化します(MAX1000行)
シート2でシート1(管理表)にデータを引用したい列は
F列・・・管理番号
H列・・・商品名
J列・・・希望納期
K列・・・回答納期
L列・・・数量
同一希望納期で同一商品名はないものとします。
検索順としては商品名⇒希望納期⇒管理番号⇒回答納期⇒数量(重複がないので検索順は変更可能)
複数条件の検索がうまくできず、暗礁に乗り上げてしまいました。
どなたか教えてください。
< 使用 Excel:Excel2010、使用 OS:Windows7 >
管理番号検索:c 商品名は2行上のD列:c.offset(-2).entirerow.cells(4).value 希望納期は3行目:c.entirecolumn.cells(3).value 回答納期は1行下:c.offset(1).value 数量は1行上:c.offset(-1).value
(マナ) 2015/04/16(木) 22:34
(マナ) 2015/04/16(木) 23:41
>検索順としては商品名⇒希望納期⇒管理番号⇒回答納期⇒数量
ん?
検索は 商品名⇒希望納期⇒管理番号 で、そこに 回答納期と数量を転記するのでは?
さらにいえば、希望納期の管理番号ということですが、1つの商品で見た場合、希望納期 と 管理番号は 1:1 ですか? それとも 1:複数 ですか? それとも 複数:1 ですか? はたまた 複数:複数ですか?
別の言い方をすれば、商品名⇒希望納期 または 商品名⇒管理番号 この検索だけでは不都合ですか?
(β) 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
ありがとうございます。
βさんのマクロでバッチリでしたm(_ _)m
(みや) 2015/04/17(金) 13:48
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.