[[20200512142514]] 『賞味期限を指定してロットを引当てをVBAで行いたax(するめ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『賞味期限を指定してロットを引当てをVBAで行いたい』(するめ)

品番 商品名 ロット  賞味  在庫数
2005 リンゴ L0000 2020/8/31 500
2005 リンゴ L1111 2020/9/30 200
2005 リンゴ L2222 2020/9/30 250
2005 リンゴ L3333 2020/10/31  300
3000 ぶどう L4444 2020/9/30 600
4000 みかん L1111 2020/9/30 400
Sheet1

賞味指定:2020/9/30 以降
品番 商品名 ロット 賞味 出荷数
2005 リンゴ       500
3000 ぶどう       500
Sheet2

賞味指定:2020/9/30 以降
品番 商品名 ロット 賞味 出荷数
2005 リンゴ       200
4000 みかん       200
Sheet3

<シート分類>
Sheet1=在庫表
Sheet2=納品書1
Sheet3=納品書2

【実現したいこと】
品番と出荷数量はシートごとに固定されている状態です。
賞味期限のみを指定し、その日付け以降を在庫表から参照し在庫数『0』になるまで、ロット引当てをマクロで行いたいです。
引当てられたロットは行もしくは列を追加する形で表示を考えております。

お分かりになる方がいればご指導いただきたく存じます。

< 使用 Excel:Excel2013、使用 OS:Windows7 >


 レイアウトを決めるのが先決です。

 引当に過不足があった場合、在庫表と納品書はどんな形にすべきなのか
 まずこれを確定してください。

 ピッタリハマる状態は何の悩みも起きないので、それは不要です。
 ロットを分けざるを得ない状況を想定してサンプル図を書いてください。

 セルアドレスが分かるようにお願いします

 >引当てられたロットは行もしくは列を追加する形で表示を考えております
 列の右方向に書き出す形の方が面倒がないと思います。

 >賞味期限のみを指定し、
 この期限をエクセルにどう伝えるのか決めてください。
 (セルに書くのか、Inputボックスを利用するのか)

 あと、作業の都合で在庫表は、品番順>賞味期限順(昇順)に並べ替えちゃっていいんですね。
 (元の並び順に戻さない)

(半平太) 2020/05/12(火) 16:33


ご回答ありがとうございます。
基礎的なマクロの知識が浅く、不明瞭な質問となってしまい申し訳ございません。

引当ての際に不足がある場合は、どの品番が何個在庫が足りないのかエラー表示をだすことは可能でしょうか。

完成させたいイメージに関しまして
まず、Sheet0に各出荷の固定の品番と数量をマスタとして持ち
在庫数から右列に追加する形で引当て後の在庫数を表示したいと考えております。
その後Sheet2、Sheet3に引き当てられたロットと賞味を下行追加して記載する形にしたいです。

<サンプル図>
賞味指定:2020/9/30 以降    賞味指定:2020/9/30 以降
品番 商品名 ロット 賞味 出荷数  品番  商品名 ロット 賞味 出荷数 
2005 リンゴ       500  2005 リンゴ      200
3000 ぶどう       500  4000 みかん      200
Sheet0
___________________________________

品番 商品名  ロット  賞味   在庫数 引当て後在庫数1 引当て後在庫数2
2005 リンゴ L0000 2020/8/31  500    500        500
2005 リンゴ L1111 2020/9/30  200    0          0
2005 リンゴ L2222 2020/9/30  250    0          0
2005 リンゴ L3333 2020/10/31 300   250        50
3000 ぶどう L4444 2020/9/30  600    100        100
4000 みかん L1111 2020/9/30  400    400        200
Sheet1
_________________________________

賞味指定:2020/9/30 以降
品番 商品名 ロット   賞味      出荷数
2005 リンゴ L1111  2020/9/30  200
2005 リンゴ L2222  2020/9/30  250
2005 リンゴ L3333  2020/9/30  50
3000 ぶどう L4444  2020/9/30  500
Sheet2

>この期限をエクセルにどう伝えるのか決めてください。
inputボックスというのは使用したことがございませんが
変更を可能にしたいので、Sheet0のマスタに記入出来ればと思います。(セルの方がよいでしょうか?)

在庫表は、品番順(昇順番)が優先されその次に賞味期限順(昇順)にて表示されます。

長々となりましたが、ご確認をお願い致します。

(するめ) 2020/05/12(火) 19:40


 >引当ての際に不足がある場合は、
 >どの品番が何個在庫が足りないのかエラー表示をだすことは可能でしょうか。 

 どのタイミングで、どうエラー表示を出すのか決めてください。

 Sheet0のセルアドレスが分かりづらいです。
  2件目はF列からなんですか?
  3件目はK列から?

(半平太) 2020/05/13(水) 00:02


Sheet0のセルアドレスを変更いたしました。
伝票No.ごとにワークシートをわけて下の行に形で、表を作成したいです。

下記のロジックをループする形でマクロ組めますでしょうか?
Sheet0(マスタ)より”伝票1”の内容を元に
Sheet1(在庫数)の右列に追加する形で引当て後の在庫数を表示させ
Sheet2(伝票1)へ”ロット”と”賞味”を下行追加する形で記載する。

Sheet0(マスタ)より”伝票2”の内容を元に
Sheet1(在庫数)の先ほどの引当て後在庫から、もう1列へ右へ追加する形で在庫数を表示させ
Sheet3(伝票2)へ”ロット”と”賞味”を下行追加して記載する。

対象となる商品ロットの在庫数が『0』になれば次ロットへ引当てたいです。

エラーを出すタイミングに関しまして
対象となる商品ロットの在庫数が『-』の値になれば
Sheet3(伝票2) のように不足数を表示する形は可能でしょうか。

<サンプル図>  
伝票No. 品番  商品名  出荷数 賞味指定(以降)  
伝票1 2005  リンゴ 500  2020/9/30
伝票1 3000  ぶどう 500  2020/9/30
伝票2 2005 りんご 300  2020/10/31
伝票2 4000 みかん 300  2020/10/31
Sheet0(マスタ)
_______________________________________________________________________________
品番 商品名  ロット  賞味   在庫数 伝票1引当て後在庫数 伝票2引当て後在庫数
2005 リンゴ L0000 2020/8/31  500    500        500
2005 リンゴ L1111 2020/9/30  200    0          0
2005 リンゴ L2222 2020/9/30  200    0          0
2005 リンゴ L3333 2020/10/31 300   200        -100
3000 ぶどう L4444 2020/9/30  600    100        100
4000 みかん L1111 2020/9/30  400    400        100
Sheet1(在庫数)
_______________________________________________________________________________
品番 商品名 ロット   賞味      出荷数
2005 リンゴ L1111  2020/9/30  200
2005 リンゴ L2222  2020/9/30  200
2005 リンゴ L3333  2020/10/31  100
3000 ぶどう L4444  2020/9/30  500
Sheet2(伝票1)
_______________________________________________________________________________
品番 商品名 ロット   賞味      出荷数
2005 リンゴ L3333  2020/10/31  200
2005 リンゴ              100個不足
4000 みかん L1111    2020/9/30   300
Sheet3(伝票2)
_______________________________________________________________________________
(するめ) 2020/05/13(水) 01:06


>セルアドレスが分かるようにお願いします
この意味わかっているのでしょうか。。
(mike) 2020/05/13(水) 09:25

何度も申し訳ございません。。。
こちらでいかがでしょうか?

   A    B   C    D    E
1 伝票No. 品番  商品名  出荷数 賞味指定(以降)  
2 伝票1 2005  リンゴ 500  2020/9/30
3 伝票1 3000  ぶどう 500  2020/9/30
4 伝票2 2005 りんご 300  2020/10/31
5 伝票2 4000 みかん 300  2020/10/31
Sheet0(マスタ)
___________________________________________________________________
   A  B    C   D     E     F         G
1 品番 商品名  ロット  賞味   在庫数 伝票1引当て後在庫数 伝票2引当て後在庫数
2 2005 リンゴ L0000 2020/8/31  500    500        500
3 2005 リンゴ L1111 2020/9/30  200    0          0
4 2005 リンゴ L2222 2020/9/30  200    0          0
5 2005 リンゴ L3333 2020/10/31 300    200        -100
6 3000 ぶどう L4444 2020/9/30  600    100        100
7 4000 みかん L1111 2020/9/30  400    400        100
Sheet1(在庫数)
_______________________________________________________________________________
   A   B    C     D       E
  品番  商品名  ロット   賞味      出荷数
1 2005  リンゴ  L1111  2020/9/30  200
2 2005  リンゴ  L2222  2020/9/30  200
3 2005  リンゴ  L3333  2020/10/31  100
4 3000  ぶどう   L4444  2020/9/30  500
Sheet2(伝票1)
_______________________________________________________________________________
   A   B    C     D        E
  品番  商品名  ロット   賞味       出荷数
1 2005  リンゴ  L3333  2020/10/31   200
2 2005  リンゴ               100個不足
3 4000  みかん  L1111  2020/9/30    300
Sheet3(伝票2)
_______________________________________________________________________________
(するめ) 2020/05/13(水) 10:49


 >   A  B    C   D     E     F         G 
 >1 品番 商品名  ロット  賞味   在庫数 伝票1引当て後在庫数 伝票2引当て後在庫数 
 >2 2005 リンゴ L0000 2020/8/31  500    500        500 
 >3 2005 リンゴ L1111 2020/9/30  200    0          0 
 >4 2005 リンゴ L2222 2020/9/30  200    0          0 
 >5 2005 リンゴ L3333 2020/10/31 300    200        -100 
 >6 3000 ぶどう L4444 2020/9/30  600    100        100 
 >7 4000 みかん L1111 2020/9/30  400    400        100 

 2行目と5行目の表示が納得いかないです。

 2行目は、1回も引当てていないですし、
 5行目は2回目で0個です。※マイナスになったのはロットL3333の責任じゃないと考えます。

 なので、こうなるべきだと思います。
      ↓
    A  B    C   D     E     F         G 
 1 品番 商品名  ロット  賞味  在庫数 伝票1引当て後在庫数 伝票2引当て後在庫数 
 2 2005 リンゴ  L0000   2020/8/31  500    
 3 2005 リンゴ  L1111   2020/9/30  200    0           
 4 2005 リンゴ  L2222   2020/9/30  200    0           
 5 2005 リンゴ  L3333   2020/10/31 300    200          0 
 6 3000 ぶどう  L4444   2020/9/30  600    100        
 7 4000 みかん  L1111   2020/9/30  400    

 最新在庫数は、行単位に見て、一番右端にある数値であると判定することになります。

 因みに、みかんは賞味期限切れなので、出荷は不可ですね。

(半平太) 2020/05/13(水) 12:05


>2行目に関しまして

賞味期限を参照し、行ごとに【在庫数-出荷数】の計算式をイメージしてましたので
引当て後、対象外のロットも【在庫数-0】となり残在庫がF列、G列へ残ると考えておりました。

ご指摘頂きました空欄表示となるのは、指定賞味外のロットは引当て無い為、計算をしないという認識でしょうかことでしょうか?
空欄表示ができるならそちらでも業務上、問題ございません。

>5行目に関しまして

L3333以降の在庫が無い状況と仮定しまして
【在庫数:200-出荷数:300】となり-100と表示となる理由は
エラー内容を分かる為に、引当て後の在庫数がマイナス値の場合は
If文で”〜個不足”と表示できるのではないかと考えておりました。

G列5行目『0』となり、Sheet3(伝票2)にエラー内容を表示する為に
その商品の不足数量が分かるロジックを組むことが可能なら、そちらで運用したく存じます。

みかんに関しては、仰る通り、私の記載ミスです。申し訳ございません。

(するめ) 2020/05/13(水) 14:06


 >賞味期限を参照し、行ごとに【在庫数-出荷数】の計算式をイメージしてましたので 
 >引当て後、対象外のロットも【在庫数-0】となり残在庫がF列、G列へ残ると考えておりました。 
 >ご指摘頂きました空欄表示となるのは、指定賞味外のロットは引当て無い為、計算をしないという認識でしょうかことでしょうか? 
 >空欄表示ができるならそちらでも業務上、問題ございません。 

 この点に付きましては、そちらの考え方もあり得るな、と思い直しています。
 初めに残高を右の列にそっくり移してしまい、
 そこから第1回目の処理で引当てた数量を差し引けば、同じ様な結果が得られます。

 なお、マイナス残はあり得ないので、最低0とします。

 ところで、Sheet0とかSheet1とか書かれているんですが、
 実際もそうなんですか?
 それとも在庫表とかマスタとかになっているんでしょうか?
 また、Sheet2とかSheet3とか実際に存在しているんでしょうか?
 あるとして、何枚まで用意されているんですか?

(半平太) 2020/05/13(水) 14:44


>Sheet0とかSheet1とか書かれているんですが、実際もそうなんですか?
Sheet1の在庫表のみ別で管理しておりますので、そちらを更新し運用しようと考えております。

>Sheet2とかSheet3とか実際に存在しているんでしょうか?
品番と出荷数が固定された伝票が5つある状態のみとなります。
実現したいことは、指定された賞味期限から、どのロットが引当たり
不足がある場合の数量を分かるようにしたいです。

その為、まず各伝票のマスタ作成して、ワークシートを5枚つくり
伝票ごとにワークシートへ引き当て結果を転記する形だと可能かと考えております。
引当て結果により行追加が起こりうるので、ワークシートをわけるのがベストかと思っています。

(するめ) 2020/05/13(水) 15:32


 ちょっと方向が分からなくなったんですが、

 >実現したいことは、指定された賞味期限から、どのロットが引当たり 
 >不足がある場合の数量を分かるようにしたいです。 

 と言う要望だけでしたら、納品書のシートは複数に分ける必要もない気がします。

 全案件を1枚のシートに順次出力すれば、一気に全貌が見渡せます。

 シートを分けると、却って、いちいち見に行かなければならないので煩雑だと思うんですが。

(半平太) 2020/05/13(水) 16:05


>全案件を1枚のシートに順次出力すれば、一気に全貌が見渡せます。
仰る通りです。その方法は非常に良いと思います。

最終的にはワークシートごとにわけて印刷する必要があるので
先にワークシートを作成して、転記するイメージでした。
ですが、全案件を1枚のシートをもち
そこから伝票ごとにワークシートを作成し転記する方が運用しやすそうだなと思いました。

このロジックでVBAは組めますでしょうか?
(するめ) 2020/05/13(水) 16:29


 >このロジックでVBAは組めますでしょうか?

 ちょこちょこ変更点が生じているので、ちょっと時間が掛かります。

 >そこから伝票ごとにワークシートを作成し転記する方が運用しやすそうだなと思いました。 

 その転記の部分は、そちらでやって頂きます。

(半平太) 2020/05/13(水) 17:28


ベースが定まっておらず、すみません。
転記に関しまして、承知致しました。
お手間をお掛けしますが、よろしくお願い致します!
(するめ) 2020/05/13(水) 17:48

 以下の3シートが存在するものとします。

 全貌、在庫表、マスタ

 標準モジュールに貼り付け
 Enum Master
     伝票NO = 1
     品番
     商品名
     出荷数
     賞味
 End Enum

 Enum 在庫
     品番 = 1
     商品名
     ロット
     賞味
     在庫数
 End Enum

 Enum 納品
     品番 = 1
     商品名
     ロット
     賞味
     出荷数
 End Enum

 Private dicT As Object
 Private key As Long
 Private Box
 Private WsInvt As Worksheet
 Private WsMast As Worksheet
 Private rMast As Range '原データ範囲取得

 Sub Sample()
     Dim PreSlipNo
     Dim CurSlipNo
     Dim i As Long
     Dim itms            '納付内訳

     Set dicT = CreateObject("Scripting.Dictionary")

     Sheets("全貌").Cells.ClearContents

     Set WsInvt = Sheets("在庫表")
     Set WsMast = Sheets("マスタ")
     Set rMast = WsMast.Range("A1").CurrentRegion '原データ範囲取得

     PreSlipNo = ""
     For i = 2 To rMast.Rows.Count + 1 '最終に1行空行を追加して、順次処理
         CurSlipNo = rMast.Rows(i).Cells(Master.伝票NO)

         If CurSlipNo <> PreSlipNo Then '伝票番号が新規
             If Not IsEmpty(CurSlipNo) Then
                 shiftBalanceToRight
             End If
             If PreSlipNo <> "" Then
                 '前伝票の後始末
                 itms = dicT.items

                 'シートへ書き出し
                 Sheets("全貌").Cells(Rows.Count, "A").End(xlUp).Offset(2).Resize(dicT.Count, 5) = _
                                                    Application.Index(itms, 0, 0)
                 dicT.RemoveAll '前伝票の記憶をクリア
             End If

             PreSlipNo = CurSlipNo

             '冒頭に伝票番号を登録
             ReDim Box(0, 1 To 5)
             Box(0, 1) = CurSlipNo
             dicT(1) = Box '

             'タイトル書き込み
             Box = WsInvt.Rows(1).Resize(1, 5).Value
             Box(1, 5) = "出荷数"
             key = 2
             dicT(key) = Box
         End If

         Call AssignByCode(rMast.Rows(i)) '伝票データを1行ずつ渡す
     Next '次の行データへ

 End Sub

 Private Sub AssignByCode(MasterRow As Range) '1品番を1行ずつ処理
     Dim tgtCD
     Dim tgtRowsInInventory As Long
     Dim tgtRowPosInInventory As Long
     Dim invSameCodeRng As Range '同一品番の在庫データ範囲
     Dim ExpireDate As Date
     Dim Shipment, Inventory
     Dim i As Long
     Dim Assignment
     Dim colPos

     tgtCD = MasterRow.Cells(Master.品番)
     tgtRowsInInventory = Application.CountIf(WsInvt.Columns(1), tgtCD)

     If tgtRowsInInventory > 0 Then '在庫データあり(残高は不明)
         tgtRowPosInInventory = Application.Match(tgtCD, WsInvt.Columns(1), 0)
         Set invSameCodeRng = WsInvt.Rows(tgtRowPosInInventory).Resize(tgtRowsInInventory)

         ExpireDate = MasterRow.Cells(Master.賞味)
         Shipment = MasterRow.Cells(Master.出荷数) '

         For i = 1 To invSameCodeRng.Count '同一品番の在庫データと突合していく

             If invSameCodeRng(i).Cells(在庫.賞味) >= ExpireDate Then
                 colPos = invSameCodeRng(i).Cells(1, Columns.Count).End(xlToLeft).Column

                 Inventory = invSameCodeRng(i).Cells(colPos)

                 If Inventory > 0 Then

                     Assignment = Application.Min(Shipment, Inventory)
                     Shipment = Shipment - Assignment
                     Inventory = Inventory - Assignment
                     '在庫残高更新
                     invSameCodeRng(i).Cells(colPos) = Inventory

                     'Dictionary更新
                     Box = invSameCodeRng(i).Resize(1, 5)
                     Box(1, 納品.出荷数) = Assignment

                     key = key + 1
                     dicT(key) = Box

                     If Shipment <= 0 Then '引当終了
                         Exit For
                     End If
                 End If
             End If
         Next i

         If Shipment > 0 Then
             Call WriteOutShortage(MasterRow.Row, Shipment)
         End If

     Else '商品番号そのものが無い
         Call WriteOutShortage(MasterRow.Row, MasterRow.Cells(1, Master.出荷数))
     End If
 End Sub

 Private Sub WriteOutShortage(RW As Long, Short)
         Box = rMast(RW, 2).Resize(1, 2)
         ReDim Preserve Box(1 To 1, 1 To 5)
         Box(1, 5) = Short & "不足"

         key = key + 1
         dicT(key) = Box
 End Sub

 Private Sub shiftBalanceToRight()
     With WsInvt '在庫残高を右へコピー
         .Cells(2, .Columns.Count).End(xlToLeft).Resize(.UsedRange.Rows.Count, 1).Offset(, 1).Value = _
         .Cells(2, .Columns.Count).End(xlToLeft).Resize(.UsedRange.Rows.Count, 1).Value
     End With
 End Sub

(半平太) 2020/05/13(水) 19:42


本当にありがとうございます!!
どう感謝を伝えれば良いか分からないほど、嬉しく思います。

私にとってすごく難解なコードですので
少しずつ理解して、これを元に応用していこうと思います。

もしも叶うことなら、半平太さんのVBAを勉強方法など
色々とご質問をさせて頂きたいのですが。。。

可能であればメールアドレスを記載致しますが、いかがでしょうか?

ご返信いただければ幸いです。
(するめ) 2020/05/14(木) 09:18


 ここで暇潰しさせて頂いているだけで、それ以外のことには無関心です。m(__)m

(半平太) 2020/05/14(木) 11:40


すごく次元の高い暇つぶしですね。。。
承知しました!
また機会がありましたらご教授の程よろしくお願い致します!
(するめ) 2020/05/14(木) 13:11

以前コードを書いて頂いたのですが
セルアドレスの変更に伴い、うまくマクロの処理ができませんでした。。。
色々と自分で調べて試しましたが、解決できなく困っております。

実現したいことは前回と同様に、賞味期限と出荷数を指定し
引き当て結果を『全貌』に表示したいです。

   A    B     C      D     E    F    G    H
1 親品番  親品名  親出荷数  賞味指定  子品番  商品名  子出荷数 合計(子)出荷数  
2  111  伝票1   200   2020/9/30  2005  リンゴ   2    400
3  111  伝票1   200   2020/9/30  3000  ぶどう   3    600
4  222  伝票2   300   2020/9/30  2005  りんご   2    600
5  222  伝票2   300   2020/9/30  4000  みかん   1    300
Sheet0(マスタ)
____________________________________________________
  A   B   C    F   G     W     Y         Z
1 区分 子品番 商品名 ロット 賞味    在庫数 引当て後在庫1 引当て後在庫2
2 国内 2005 リンゴ L0000 2020/8/31  500    500      500
3 国内 2005 リンゴ L1111 2020/9/30  200    0        0
4 内貨 2005 リンゴ L2222 2020/9/30  100    0        0
5 内貨 2005 リンゴ L3333 2020/10/31 300    200       0
6 国外 3000 ぶどう L4444 2020/9/30  700    100       100
7 国内 4000 みかん L1111 2020/8/31  400    400       400
Sheet1(在庫数)
____________________________________________________
  A   B    C   D   E   F     G     H
1 親品番 親品名 区分 子品番 商品名 ロット 賞味期限   出荷数
2 111 伝票1  国内 2005 リンゴ L1111 2020/9/30  200 
3 111 伝票1  内貨 2005 リンゴ L2222 2020/9/30  100
4 111 伝票1  内貨 2005 リンゴ L3333 2020/10/31 100
5 111 伝票1  国外 3000 ぶどう L4444 2020/9/30  600
6 222 伝票2  内貨 2005 リンゴ L3333 2020/10/31 200
7 222 伝票2     2005 リンゴ           400不足
8 222 伝票2     4000 みかん           300不足
Sheet2(全貌)

・運用方法としましては(マスタ)C列、D列を指定しH列の計算式にて合計出荷数をだします。(その他の列は固定値)
・(在庫数)は別で在庫管理している表を張り付けしたいです。実際の表はA列〜W列まであるので、セルアドレスは必要な部分のみ抜粋いたしました。
・実務では(マスタ)の親伝票は5つございます。

こちらでコード修正をして頂くことはできますでしょうか?

(するめ) 2020/05/20(水) 00:09


 Enum Master
     親品番 = 1
     伝票NO
     ワンロット数
     賞味
     品番
     商品名
     子出荷ロット
     出荷数計
 End Enum

 Enum 在庫
     区分 = 1
     品番
     商品名
     ロット = 6
     賞味
     在庫数 = 23
 End Enum

 Enum 納品
     親品番 = 1
     伝票名
     区分
     子品番
     商品名
     ロット
     賞味
     出荷数
 End Enum

 Private dicT As Object
 Private key As Long
 Private Box
 Private WsInvt As Worksheet
 Private WsMast As Worksheet
 Private rMast As Range '原データ範囲取得

 Sub Sample()
     Dim PreSlipNo
     Dim CurSlipNo
     Dim i As Long
     Dim itms            '納付内訳

     Set dicT = CreateObject("Scripting.Dictionary")

     Sheets("全貌").Cells.ClearContents
     Sheets("全貌").Range("A1:H1") = _
         Array("親品番", "親品名", "区分", "子品番", "商品名", "ロット", "賞味期限", "出荷数")

     Set WsInvt = Sheets("在庫表")
     Set WsMast = Sheets("マスタ")
     Set rMast = WsMast.Range("A1").CurrentRegion '原データ範囲取得

     PreSlipNo = ""
     For i = 2 To rMast.Rows.Count + 1 '最終に空行を1つ追加して、順次処理
         CurSlipNo = rMast.Rows(i).Cells(Master.伝票NO)

         If CurSlipNo <> PreSlipNo Then '伝票番号が新規
             If Not IsEmpty(CurSlipNo) Then
                 shiftBalanceToRight
             End If

             If PreSlipNo <> "" Then
                 '前伝票の後始末
                 itms = dicT.items

                 'シートへ書き出し
                 Sheets("全貌").Cells(Rows.Count, "A").End(xlUp).Offset(2).Resize(dicT.Count, 8) = _
                                                    Application.Index(itms, 0, 0)
                 dicT.RemoveAll '前伝票の記憶をクリア
             End If

             PreSlipNo = CurSlipNo
         End If

         Call AssignByCode(rMast.Rows(i)) '伝票データを1行ずつ渡して、個別引当処理
     Next '次の行データへ

 End Sub

 Private Sub AssignByCode(MasterRow As Range) '1親品番を1行ずつ処理
     Dim tgtCD
     Dim tgtRowsInInventory As Long
     Dim tgtRowPosInInventory As Long
     Dim invSameCodeRng As Range '同一親品番の在庫データ範囲
     Dim ExpireDate As Date
     Dim Shipment, Inventory
     Dim i As Long
     Dim Assignment
     Dim colPos

     tgtCD = MasterRow.Cells(Master.品番)
     tgtRowsInInventory = Application.CountIf(WsInvt.Columns(在庫.品番), tgtCD)

     If tgtRowsInInventory > 0 Then '在庫データあり(残高は不明)
         tgtRowPosInInventory = Application.Match(tgtCD, WsInvt.Columns(在庫.品番), 0)
         Set invSameCodeRng = WsInvt.Rows(tgtRowPosInInventory).Resize(tgtRowsInInventory)

         ExpireDate = MasterRow.Cells(Master.賞味)
         Shipment = MasterRow.Cells(Master.出荷数計) '

         For i = 1 To invSameCodeRng.Count '同一品番の在庫データと突合していく

             If invSameCodeRng(i).Cells(在庫.賞味) >= ExpireDate Then
                 colPos = invSameCodeRng(i).Cells(1, Columns.Count).End(xlToLeft).Column

                 Inventory = invSameCodeRng(i).Cells(colPos)

                 If Inventory > 0 Then

                     Assignment = Application.Min(Shipment, Inventory)
                     Shipment = Shipment - Assignment
                     Inventory = Inventory - Assignment
                     '在庫残高更新
                     invSameCodeRng(i).Cells(colPos) = Inventory

                     'Dictionary更新
                     Box = MasterRow.Cells(Master.親品番).Resize(1, 2)

                     ReDim Preserve Box(1 To 1, 1 To 納品.出荷数)

                     Box(1, 納品.区分) = invSameCodeRng(i).Cells(在庫.区分)
                     Box(1, 納品.子品番) = invSameCodeRng(i).Cells(在庫.品番)
                     Box(1, 納品.商品名) = invSameCodeRng(i).Cells(在庫.商品名)
                     Box(1, 納品.ロット) = invSameCodeRng(i).Cells(在庫.ロット)
                     Box(1, 納品.賞味) = invSameCodeRng(i).Cells(在庫.賞味)
                     Box(1, 納品.出荷数) = Assignment

                     key = key + 1
                     dicT(key) = Box

                     If Shipment <= 0 Then '引当終了
                         Exit For
                     End If
                 End If
             End If
         Next i

         If Shipment > 0 Then
             Call WriteOutShortage(MasterRow.Row, Shipment)
         End If

     Else '商品番号そのものが無い
         Call WriteOutShortage(MasterRow.Row, MasterRow.Cells(1, Master.出荷数計))
     End If
 End Sub

 Private Sub WriteOutShortage(RW As Long, Short)
         Box = rMast(RW, 1).Resize(1, 2)
         ReDim Preserve Box(1 To 1, 1 To 納品.出荷数)
         Box(1, 納品.子品番) = rMast(RW, Master.品番)
         Box(1, 納品.商品名) = rMast(RW, Master.商品名)
         Box(1, 納品.出荷数) = Short & "不足"

         key = key + 1
         dicT(key) = Box
 End Sub

 Private Sub shiftBalanceToRight()
     Dim rightestCL, newRightest, invBalance

     With WsInvt '在庫残高を右へコピー
         rightestCL = .Cells(2, .Columns.Count).End(xlToLeft).Column
         invBalance = .Cells(2, rightestCL).Resize(.UsedRange.Rows.Count, 1).Value

         newRightest = Application.Max(rightestCL + 1, 在庫.在庫数 + 2)
         .Cells(2, newRightest).Resize(.UsedRange.Rows.Count, 1).Value = invBalance

     End With
 End Sub

(半平太) 2020/05/20(水) 09:33


早速のご返事ありがとうございます!

全貌に反映される表示形式はイメージ通りです!!
いつもいつもありがとうございますm(__)m

しかし、指定した賞味以降の対象商品は、必要数量分残っている場合も、不足と表示されてしまいます。。。

引当て結果がうまくいっていないと思われますが
私が述べた情報で足りない部分などございましたでしょうか?
(するめ) 2020/05/20(水) 14:17


 そちらのサンプルデータでトライした限りでは、希望図通りになりましたけど?

 旨く行かないことが再現できるサンプルデータを提示してください。

(半平太) 2020/05/20(水) 16:18


・(在庫表)はA列〜W列まであると申しましたが、正しくはA列〜X列でした。
その為、引当て結果はX列の数量から反映されてしまったと思います。

私の確認不足で申し訳ございません。
下記のセルアドレスは同様でございます。

>Enum 在庫

     区分 = 1
     品番
     商品名
     ロット = 6
     賞味
     在庫数 = 23

お手数をおかけしますが、ご確認をお願い致します。
(するめ) 2020/05/20(水) 17:01


 1.位置修正(1か所)
     在庫数 = 23
               ↓
     在庫数 = 24

 2.丸ごと取り換え(1プロシージャ)

 Private Sub shiftBalanceToRight()
     Dim rightestCL, invBalance

     With WsInvt '在庫残高を右へコピー
         rightestCL = .Cells(2, .Columns.Count).End(xlToLeft).Column
         invBalance = .Cells(2, rightestCL).Resize(.UsedRange.Rows.Count, 1).Value
         .Cells(2, rightestCL + 1).Resize(.UsedRange.Rows.Count, 1).Value = invBalance
     End With
 End Sub

(半平太) 2020/05/20(水) 17:25


説明の仕方が悪く、申し訳ございません。
変更して行ってみましたが、X列の数量より引当てられていると思います。
試しにX列を削除してマクロ実行すると、イメージ通りの引当て結果でした。

(在庫表)はA列〜X列まであり、W列の在庫数より対象商品の引当てを行い、
Y列、Z列…へ引当て後在庫数を表示することは可能でしょうか?

(するめ) 2020/05/20(水) 17:49


 >X列の数量より引当てられていると思います。 

 X列まであるなら、X列の残高から引き当てるのは当然じゃないですか?

(半平太) 2020/05/20(水) 17:58


仰る通りです。
在庫管理表の都合上、W列に在庫数があり、X列に別の数字があるフォーマットとなっております。

W列の在庫から引当てるロジックが複雑でしたら
X列を削除をするようにマクロでしたく存じます。

Sheets("在庫表").Columns(24).Delete

を最初に加えればよろしいでしょうか?
(するめ) 2020/05/20(水) 18:26


 >W列の在庫から引当てるロジックが複雑でしたら 

 初回だけ1列飛び越せばいいので、どうと言うことはないです。

 1.在庫数 = 24 ’X列のまま

 2.丸ごと取り換え(1プロシージャ)

 Private Sub shiftBalanceToRight()
     Dim rightestCL

     With WsInvt '在庫残高を右へコピー
         rightestCL = .Cells(2, .Columns.Count).End(xlToLeft).Column

         If rightestCL <= 在庫.在庫数 Then
             .Cells(2, 在庫.在庫数 + 1).Resize(.UsedRange.Rows.Count, 1).Value = _
             .Cells(2, 在庫.在庫数 - 1).Resize(.UsedRange.Rows.Count, 1).Value
         Else
             .Cells(2, rightestCL + 1).Resize(.UsedRange.Rows.Count, 1).Value = _
             .Cells(2, rightestCL).Resize(.UsedRange.Rows.Count, 1).Value
         End If
     End With
 End Sub

(半平太) 2020/05/20(水) 20:17


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.