[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『部門の生産計画』（セサミン）
お世話になります。 部門独自の生産計画を作成したくお力を貸して下さい。 少々複雑ですので、サンプルデータを作成し下記に置きました。 http://fast-uploader.com/file/7017889161934/ パスワード123456 期限一週間 よろしくお願いします。
説明欄のみ添付します。 【目的】 1.表１から、表２の数量欄を計算させたい。できれば結果を表１の生産欄へ表示させたい （当初順列・生産欄は空欄で、埋めながら作成している） 2.表１の「出荷」はメインライン生産数、「生産」はサブライン生産数 3.生産は一日後～四日後が埋まればOK
【現在の手順】 1.日々の作業終了後に在庫数を調べてE4:E11に記入 2.メインラインの生産計画を「出荷」欄に記載 3.在庫にマイナスが出た品番を目で追いながら一日後～四日後の生産計画をハンドで組む 4.表１完成後、表２のようなボードに品番・数量を転記
【条件】 1.生産ロット数の目安はD4:D12。400単位に増減ok（品番50のみ300単位に増減）。材料が数日分しか入荷しないので目安分よりもあまり多くできない。 2.max生産はメインライン4000、サブライン4300程度 3.当日最終生産の残ったロット分は、翌日の頭から生産。端数ok 4.「型A」「型B」品番を交互に生産 5.交互生産で在庫バランスが崩れれば、同一型連続もOK。ただロスが出るので日産maxは4300→3800程度 6.メインライン生産数は頻繁に変更あり。イレギュラーも多いので、ハンド入力もokに 7.表１・表２ともフォームに拘らない。生産順列・数量が分かればOK 8.在庫は5000～6000持てる
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
＞ 少々複雑ですので、サンプルデータを作成し下記に置きました。
ファイルのダウンロードはちょっと怖いので、サンプル再現マクロを提示しますので、 それで出来上がったコードをここにアップしていただけませんか？
それを使っていただくと、(そちらも）、こちらもクリック一発ですむので手間が省けます。
<手順> (1) 吸い上げ対象となるシートの「シート見出し」を右クリックして、コードの選択を選ぶ。 すると、画面中央に白いエリアが出ます。(VBE画面と呼ばれています。) そこに後記マクロコードを貼り付けてください。
(2) Altキーを押しながらF11キーを推すと、エクセルの画面に戻りますので、 本問に関連するセル範囲をドラッグ選択してください。
選択範囲は、必要最小限の広さにしてください。
(3) 範囲が選択された状態で、再度、Altキーを押しながらF11キーを押してVBE画面に戻り、 F5キーを押下する（＝「レイアウトとサンプルデータ再現マクロ作成」マクロ実行となる）
するとマクロが実行され、「出力Wsh」と云うシートが挿入され、
所要マクロコードが書きこまれます。
同時に、自動的にクリップボードにもマクロコードが記憶されます。
なので、マクロを実行した後、直ぐこの掲示板なり、下書き用のメモ帳なりに行って、
右クリック→貼付け を行えば自動作成されたマクロコードが貼り付きます。
自動生成されたマクロ名は「onlyOnce」です。それを掲示板にアップして頂くと完了となるんですけど・・・
※ 他の回答者からレスが付けば、本レスは無視願います。
’シートに貼り付けるべきマクロコード ここから －－－－－－－－－－－－－－－
Public Sub レイアウトとサンプルデータ再現マクロ作成()
Const modelMRG As String = " Range(""Adrs"").Merge"
Const modelCLR As String = " Range(""Adrs"").Interior.ColorIndex = "
Const modelVAL2 As String = " Range(""Adrs"").Value = "
Const modelFML As String = " Range(""Adrs"").FormulaR1C1Local = "
Const modelFMT As String = " Range(""Adrs"").NumberFormatLocal = ""@""" '文字列(頭が「’」のデータ処理
Const modelFME As String = " Range(""Adrs"").NumberFormatLocal = " '標準外の表示形式
Dim WSF As WorksheetFunction
Dim rslt
Dim dataToFil
Dim cel As Range
Dim Codes As String
Dim NN As Long, PP As Long
Dim BlocksToRight As Long, BlocksToBottom
Dim rngSelected As Range
Set rngSelected = Intersect(Selection, Selection.Parent.UsedRange)
If rngSelected.Rows.Count > 200 Or _
rngSelected.Columns.Count > 78 Then
If vbNo = MsgBox("対象範囲(" & rngSelected.Address(0, 0) & _
"）が広過ぎの感がありますが、範囲は正しいですか？", vbYesNo) Then
Exit Sub
End If
End If
Set WSF = WorksheetFunction
On Error Resume Next
ThisWorkbook.Sheets("出力Wsh").Range("A1").Value = Empty 'シート存在テスト
If Err.Number <> 0 Then
ThisWorkbook.Sheets.Add.Name = "出力Wsh"
End If
On Error GoTo 0
NN = 0
With ThisWorkbook.Sheets("出力Wsh")
NN = NN + 1: .Cells(NN, 1).Value = "Private Sub onlyOnce()"
NN = NN + 1: .Cells(NN, 1).Value = "Rem ' Range(""" & rngSelected.Address(, , , True) & """).Clear"
NN = NN + 1: .Cells(NN, 1).Value = Empty
NN = NN + 1: .Cells(NN, 1).Value = " Rem 結合状態を処理"
For Each cel In rngSelected '結合状態を処理----------------
With cel
If .MergeCells Then '結合状態になっているセルを処理
If .MergeArea.Item(1).Address = .Address Then
NN = NN + 1
dataToFil = Replace(modelMRG, "Adrs", .MergeArea.Cells.Address(0, 0))
ThisWorkbook.Sheets("出力Wsh").Cells(NN, 1).Value = dataToFil
End If
End If
End With
Next
NN = NN + 1: .Cells(NN, 1).Value = Empty
NN = NN + 1: .Cells(NN, 1).Value = " Rem 数式セル以外をまとめて処理"
rslt = sameKindS(rngSelected, modelVAL2, "値")
For PP = LBound(rslt) To UBound(rslt)
If rslt(PP) <> Empty Then
' NN = NN + 1: .Cells(NN, 1).Value = rslt(PP)
rslt(PP) = Replace(rslt(PP), vbLf, """ & Chr(10) & """)
NN = NN + 1: .Cells(NN, 1).Value = rslt(PP)
End If
Next PP
NN = NN + 1: .Cells(NN, 1).Value = Empty
NN = NN + 1: .Cells(NN, 1).Value = " Rem 数式セルをまとめて処理"
rslt = sameKindS(rngSelected, modelFML, "数式")
For PP = LBound(rslt) To UBound(rslt)
If rslt(PP) <> Empty Then
NN = NN + 1: .Cells(NN, 1).Value = rslt(PP)
End If
Next PP
NN = NN + 1: .Cells(NN, 1).Value = Empty
NN = NN + 1: .Cells(NN, 1).Value = " Rem 標準外書式セルをまとめて処理"
rslt = sameKindS(rngSelected, modelFME, "セル書式")
For PP = LBound(rslt) To UBound(rslt)
If rslt(PP) <> Empty Then
NN = NN + 1: .Cells(NN, 1).Value = rslt(PP)
End If
Next PP
NN = NN + 1: .Cells(NN, 1).Value = Empty
NN = NN + 1: .Cells(NN, 1).Value = " Rem 塗りつぶしセルをまとめて処理"
rslt = sameKindS(rngSelected, modelCLR, "塗りつぶし")
For PP = LBound(rslt) To UBound(rslt)
If rslt(PP) <> Empty Then
NN = NN + 1: .Cells(NN, 1).Value = rslt(PP)
End If
Next PP
NN = NN + 1: .Cells(NN, 1).Value = "End Sub"
.Range("A1").Resize(NN, 1).Copy
End With
End Sub
Private Function sameKindS(rng As Range, modelFMS, Optional aim As String = "値") '一般形
Dim dic As Object
Dim cel As Range
Dim Adrs As String
Dim AdrsBreak
Dim sNum As String
Dim eachKey
Dim NN As Long
Dim dataToFil
Dim ItemVal
Set dic = CreateObject("Scripting.Dictionary") ' 連想配列の定義
For Each cel In rng
ItemVal = Empty
Select Case aim
Case "値"
If Not cel.HasFormula And Not IsEmpty(cel.Value) Then
ItemVal = IIf(IsError(cel.Value2), cel.Formula, cel.Value2)
End If
Case "数式"
If cel.HasFormula Then
ItemVal = cel.FormulaR1C1Local
End If
Case "セル書式"
If cel.NumberFormatLocal <> "G/標準" And _
TypeName(cel.Value) <> "Currency" Then '標準外の書式を反映させる。通貨型は面倒なので処理外
ItemVal = cel.NumberFormatLocal
End If
Case "塗りつぶし"
If cel.Interior.ColorIndex <> -4142 Then '塗りつぶしがあるセルを処理
ItemVal = cel.Interior.ColorIndex
End If
End Select
If Not IsEmpty(ItemVal) Then
If dic.Exists(ItemVal) Then
AdrsBreak = Split(dic(ItemVal), "#")
sNum = AdrsBreak(0) + 1
dic(ItemVal) = sNum & "#" & AdrsBreak(1) & cel.Address(0, 0) & " "
Else
dic.Add ItemVal, "1#" & cel.Address(0, 0) & " "
End If
End If
Next
Dim rslt()
Dim brd
ReDim rslt(0 To Application.Max(0, dic.Count - 1))
NN = 0
For Each eachKey In dic
AdrsBreak = Split(dic(eachKey), "#")
Adrs = Replace(RTrim(AdrsBreak(1)), " ", ",")
Adrs = AddressUnited(Adrs) 'バラバラのAddressを統合
For Each brd In Split(Adrs, "#!#")
If brd <> "" Then
dataToFil = IIf(Application.IsText(eachKey), """", "") & Replace(eachKey, """", """""") & _
IIf(Application.IsText(eachKey), """", "")
dataToFil = Replace(modelFMS, "Adrs", brd) & dataToFil
NN = NN + 1
If NN - 1 > UBound(rslt) Then
ReDim Preserve rslt(0 To NN - 1)
End If
rslt(NN - 1) = dataToFil
End If
Next
Next
sameKindS = rslt
End Function
Private Function AddressUnited(adr) 'バラバラのAddressを統合
Dim scopeRange As Range
Dim adrRemain As String
Dim adrForRowProc As String
Dim adrForColProc As String
Set scopeRange = Range(Split(adr, ",")(0))
adrRemain = "," & adr & ","
Do While Not scopeRange Is Nothing
uniteRowDir scopeRange, adrRemain
adrForRowProc = adrForRowProc & scopeRange.Address(0, 0) & ","
If Len(adrRemain) < 4 Then
Set scopeRange = Nothing
Else
Set scopeRange = Range(Split(adrRemain, ",")(1))
End If
Loop
Set scopeRange = Range(Split(adrForRowProc & ",", ",")(0))
adrRemain = "," & adrForRowProc
Do While Not scopeRange Is Nothing
uniteColDir scopeRange, adrRemain
adrForColProc = adrForColProc & scopeRange.Address(0, 0) & ","
If Len(adrRemain) < 4 Then
Set scopeRange = Nothing
Else
Set scopeRange = Range(Split(adrRemain, ",")(1))
End If
Loop
AddressUnited = get小分け(adrForColProc) '10セル以上は長いので同じ構文でも分割作成
End Function
Function get小分け(adrForColProc)
Dim strSRC
Dim brDown, Cntr, sss, QQ, adrsUnit, numOfadrs
brDown = Split(adrForColProc, ",")
numOfadrs = UBound(brDown) '対象個数
adrsUnit = Int((numOfadrs - 1) / 10) + 1
adrsUnit = Application.RoundUp(UBound(brDown) / adrsUnit, 0) 'まとめるアドレスの数
For Cntr = 0 To numOfadrs - 1 Step adrsUnit
sss = stEd(Cntr, Application.Min(numOfadrs - 1, Cntr + adrsUnit - 1), brDown)
strSRC = IIf(strSRC = "", sss, strSRC & "#!#" & sss)
Next Cntr
get小分け = strSRC & "#!#"
End Function
Function stEd(st, ed, ary)
Dim NN, str
str = ary(st)
For NN = st + 1 To ed
str = str & "," & ary(NN)
Next NN
stEd = str
End Function
Private Sub uniteRowDir(ByRef scopeRange, ByRef adrRemain)
Dim brdAry
brdAry = Split(adrRemain, ",")
adrRemain = Replace(adrRemain, "," & brdAry(1) & ",", ",") 'アドレス文字列から除外
If Range(brdAry(1)).Cells(1, 2).Address(0, 0) = brdAry(2) Then '右横に同じものあり
Set scopeRange = Range(scopeRange, Range(brdAry(2)))
uniteRowDir scopeRange, adrRemain
End If
End Sub
Private Sub uniteColDir(ByRef scopeRange, ByRef adrRemain) '直下が同じ範囲かチェック
Dim brdAry
Dim adrsUnder As String
brdAry = Split(adrRemain, ",")
adrRemain = Replace(adrRemain, "," & scopeRange.Rows(scopeRange.Rows.Count).Address(0, 0) & ",", ",") 'アドレス文字列から除外
adrsUnder = scopeRange.Rows(scopeRange.Rows.Count + 1).Address(0, 0) '結合セル対策
If adrRemain Like "*," & adrsUnder & ",*" Then '真下に同じものあり
Set scopeRange = Range(scopeRange, Range(adrsUnder))
uniteColDir scopeRange, adrRemain
End If
End Sub
’ここまで
（半平太） 2016/05/04(水) 16:18
半平太さん やってみました。これでよろしいでしょうか？ 「(1) ～ のコードの選択」は「コードの表示(V)」のことですね？ 開発→マクロ からこのマクロは見えなかったのですが、F8で一行ずつ実行すると概ね再現できました。 （罫線などは再現されませんでした。） よろしくお願いします。
Private Sub onlyOnce()
Rem ' Range("[サブライン生産計画.xlsx]投稿用!$A$1:$AC$34").Clear
Rem 結合状態を処理
Range("L1:M1").Merge
Range("E15:F15").Merge
Rem 数式セル以外をまとめて処理
Range("B1").Value = "【表１ メインラインへの出荷】"
Range("K1,D15").Value = "作成日"
Range("L1,E2,E15").Value = 42498
Range("D2,H3,L3,P3,T3").Value = "生産"
Range("F2").Value = 42499
Range("J2").Value = 42500
Range("N2").Value = 42501
Range("R2").Value = 42502
Range("V2").Value = 42503
Range("Y2").Value = 42504
Range("B3,C16").Value = "品番"
Range("C3,D16").Value = "型"
Range("D3").Value = "ロット"
Range("E3,I3,M3,Q3,U3,X3,AA3").Value = "在庫"
Range("F3,J3,N3,R3,V3,Y3").Value = "出荷"
Range("G3,K3,O3,S3,B16").Value = "順列"
Range("B4,C23").Value = "品番10"
Range("C4:C8").Value = "A"
Range("D4,L4,D9,H9,T9,D10:E10,L10").Value = 800
Range("E4").Value = 900
Range("F4").Value = 130
Range("J4,R10,V10").Value = 160
Range("K4,B23").Value = 7
Range("N4,R4,V4,Y4,J10").Value = 220
Range("B5,C17,C25,C27").Value = "品番20"
Range("D5,H5,P5,T5").Value = 2400
Range("E5,N11,R11,V11,Y11").Value = 1100
Range("F5").Value = 1480
Range("G5,B17").Value = 1
Range("J5,D7,L7,D11,H11,P11").Value = 1600
Range("N5,R5,V5,Y5").Value = 1700
Range("O5,B25").Value = 9
Range("S5,B27").Value = 11
Range("B6,C19").Value = "品番30"
Range("D6,H6").Value = 400
Range("E6").Value = 20
Range("F6").Value = 0
Range("G6,B19").Value = 3
Range("J6,N6,R6,V6,Y6,J8").Value = 70
Range("B7,C21").Value = "品番40"
Range("E7").Value = 600
Range("F7,J7").Value = 500
Range("K7,B21").Value = 5
Range("N7,R7,V7,Y7").Value = 430
Range("B8").Value = "品番50"
Range("D8,J9").Value = 300
Range("E8").Value = 200
Range("F8").Value = 60
Range("N8,R8,V8,Y8,S9,B26").Value = 10
Range("B9,C18,C26").Value = "品番100"
Range("C9:C11").Value = "B"
Range("E9").Value = 90
Range("F9").Value = 120
Range("G9,B18").Value = 2
Range("N9,R9,V9,Y9").Value = 250
Range("B10,C22").Value = "品番200"
Range("F10").Value = 180
Range("K10,B22").Value = 6
Range("N10,Y10").Value = 150
Range("B11,C20,C24").Value = "品番300"
Range("E11").Value = 2000
Range("F11,J11").Value = 1000
Range("G11,B20").Value = 4
Range("O11,B24").Value = 8
Range("B12").Value = "合計"
Range("B14").Value = "【表２ サブライン生産台数】"
Range("J14").Value = "【目的】"
Range("B15").Value = "翌日の生産"
Range("J15").Value = "1.表１から、表２の数量欄を計算させたい。できれば結果を表１の生産欄へ表示させたい"
Range("E16").Value = "数量"
Range("F16").Value = "累計"
Range("J16").Value = " （当初、順列・生産欄は空欄で埋めながら作成している）"
Range("G17").Value = "┐"
Range("J17").Value = "2.表１の「出荷」はメインライン生産数、「生産」はサブライン生産数"
Range("G18").Value = "├ 翌日"
Range("J18").Value = "3.生産は一日後～四日後が埋まればOK"
Range("G19,G22,G27").Value = "│"
Range("G20,G23,G25,G28").Value = "┤"
Range("J20").Value = "【現在の手順】"
Range("G21").Value = "├ 翌々日"
Range("J21").Value = "1.日々の作業終了後に在庫数を調べてE4:E11に記入"
Range("J22").Value = "2.メインラインの生産計画を「出荷」欄に記載"
Range("J23").Value = "3.在庫にマイナスが出た品番を目で追いながら一日後～四日後の生産計画をハンドで組む"
Range("G24").Value = "├ 翌翌々日"
Range("J24").Value = "4.表１完成後、表２のようなボードに品番・数量を転記"
Range("G26").Value = "├ 翌翌翌々日"
Range("J26").Value = "【条件】"
Range("J27").Value = "1.生産.ロット数の目安はD4:D12。400単位に増減ok（品番50のみ300単位に増減）。材料が数日分しか入荷しないので目安分からあまり多くできない。"
Range("B28").Value = 12
Range("J28").Value = "2.max生産はメインライン4000、サブライン4300程度"
Range("B29").Value = 13
Range("J29").Value = "3.当日最終生産の残ったロット分は、翌日の頭から生産。端数ok"
Range("J30").Value = "4.「型A」「型B」品番を交互に生産"
Range("J31").Value = "5.交互生産で在庫バランスが崩れれば、同一型連続もOK。ただロスが出るので日産maxは4300→3800程度"
Range("J32").Value = "6.メインライン生産数は頻繁に変更あり。イレギュラーも多いので、ハンド入力もokに"
Range("J33").Value = "7.表１・表２ともフォームに拘らない。生産順列・数量が分かればOK"
Range("J34").Value = "8.在庫は5000～6000持てる"
Rem 数式セルをまとめて処理
Range("I4:I11,M4:M11,Q4:Q11,U4:U11").FormulaR1C1Local = "=RC[-4]-RC[-3]+RC[-1]"
Range("X4:X11,AA4:AA11").FormulaR1C1Local = "=RC[-3]-RC[-2]+RC[-1]"
Range("E12:F12,H12,J12,L12,N12,P12,R12,T12,V12,Y12").FormulaR1C1Local = "=SUM(R[-8]C:R[-1]C)"
Range("D17:D29").FormulaR1C1Local = "=VLOOKUP(RC[-1],R4C[-2]:R11C,2,0)"
Range("E17:E29").FormulaR1C1Local = "=VLOOKUP(RC[-2],R4C[-3]:R11C[-1],3,0)"
Range("F17").FormulaR1C1Local = "=RC[-1]"
Range("F18:F29").FormulaR1C1Local = "=R[-1]C+RC[-1]"
Rem 標準外書式セルをまとめて処理
Range("L1:M1,Z1,E15:F15").NumberFormatLocal = "m""月""d""日"""
Range("E2:AA2,F3:AA3").NumberFormatLocal = "m/d;@"
Range("A4:A23,D4:AB13,D14:K14,U14:AC15,G15:I15,E16:I21,V16:AC16,U17:AC23").NumberFormatLocal = "#,##0;[赤]-#,##0"
Range("E22:K22,E23:I23,E24:G29,J28,K29,J30,K31").NumberFormatLocal = "#,##0;[赤]-#,##0"
Rem 塗りつぶしセルをまとめて処理
Range("H3:H11,L3:L11,P3:P11,T3:T11,E16:E29").Interior.ColorIndex = 35
End Sub
（セサミン） 2016/05/04(水) 17:18
＞やってみました。これでよろしいでしょうか？
ありがとうございました。 これから、質問と照らし合わせてみます。
＞（罫線などは再現されませんでした。）
私の能力(気力？）では、罫線までフォローできるものは作れなかったです。 とほほ m(__)m
（半平太） 2016/05/04(水) 20:06
最初から、つまずいているんですけど・・・
＞ 【目的】 ＞ 1.表１から、表２の数量欄を計算させたい。できれば結果を表１の生産欄へ表示させたい ＞ （当初順列・生産欄は空欄で、埋めながら作成している）
「計算」と言っても「転記」に毛の生えた程度にしか見えないです。
そう読むと、上記１の前段と後段で、矛盾しているようにも感じるのですけど、私の勘違い？ 表１の生産欄を見て、表２の数量を転記するのですから、 それをまた表１に表示させるというのは、単に元に戻るだけじゃないですか？ 対象項目が、前段と後段では、言っていること(モノ？）が違うんですか？
あと、データ量ですけど、品番は全部で何種類くらいあるんですか？
（半平太） 2016/05/04(水) 21:18
もしかして、表１の数量(手入力したもの）は、かなりアバウトなものであり、 それを質問文にある「条件」に合うように修正する、と言うことが、 「表２の数量欄を計算させたい」と言う意味なんでしょうか？
（半平太） 2016/05/04(水) 21:38
もしかして、表１への手入力は、当日末在庫と出荷量だけとし、 そのデータに基づいて、表２を完成させる、と言うことが、 「表２の数量欄を計算させたい」と言う意味なんでしょうか？
（半平太） 2016/05/04(水) 21:47
ご尽力いただきありがとうございます。分かりにくくてすいません。
> 「計算」と言っても「転記」に毛の生えた程度にしか見えないです。 その通りそうです。 サンプルデータは質問用に作成した完成されたものなので 表１のGHKLOPST列と表２のC17:C29をブランクにしていただいた方が分かりやすかもしれません。
生産欄がブランクだと多くの在庫欄がマイナスになります。 マイナスになっている在庫の生産欄を埋めながら順列・品番・生産数を確認し、 その内容を表２に転記しています。 これらを自動化できないかと考えています。 （出荷欄にはメインラインの生産台数を自動的に反映させようと考えています） したがって「21:47」の書き込みされたイメージになろうかと思います。
> データ量ですけど、品番は全部で何種類くらいあるんですか？ 現在は８種類です。将来的に新製品がでれば増える可能性はありますが、増えて15種くらいでしょうか…。
（セサミン） 2016/05/05(木) 00:10
＞表１のGHKLOPST列と表２のC17:C29をブランクにしていただいた方が分かりやすかもしれません。 : : ＞したがって「21:47」の書き込みされたイメージになろうかと思います。
納得です。
＞2.max生産はメインライン4000、サブライン4300程度 (1)maxは、全品番の合計値ですね？ 出来るだけmaxに近づける様にした方が、いいのでしょうか？ それとも、maxはギリギリなので、その8割程度が居心地がいいのでしょうか？
＞ 4.「型A」「型B」品番を交互に生産 ＞ 5.交互生産で在庫バランスが崩れれば、同一型連続もOK。ただロスが出るので日産maxは4300→3800程度 (2)ここがよく分からないのですが、素人としては、１日何種類も品番を変えると ロスが多くなるので、「型A」「型B」は交互にするとしても、 出来るだけ同じ品番を沢山作る方がいいのではないかと思ったりするのですが、合ってますか？ それとも、交互生産になってさえいれば、１日に扱う品番の種類が多くなるのは大した問題じゃないのでしょうか？
＞ 6.メインライン生産数は頻繁に変更あり。イレギュラーも多いので、ハンド入力もokに (3)メインライン生産数(これは出荷数の意味ですよね）は元々手入力するデータだと理解しているのですが、 あえて「ハンド入力もok」と書いた意味はなんですか？ 「何度でも再計算させたい」と言う意味と理解していいですか？
＞ 8.在庫は5000～6000持てる (4)これも上記(1)の同じで、その範囲で持つのが理想なんですか？ それとも、その8割程度が居心地がいいのでしょうか？
（半平太） 2016/05/05(木) 09:32
＞2.max生産はメインライン4000、サブライン4300程度 (1)maxは、全品番の合計値ですね？ 出来るだけmaxに近づける様にした方が、いいのでしょうか？ それとも、maxはギリギリなので、その8割程度が居心地がいいのでしょうか？
■maxは全品番の合計数です。メインラインは営業部門（市場）の要望に応えた数値です。 メインランが～4000で計画を立てるのでそれに合わせます。 以下(2)～(4)もご参考になさって下さい。
＞ 4.「型A」「型B」品番を交互に生産 ＞ 5.交互生産で在庫バランスが崩れれば、同一型連続もOK。ただロスが出るので日産maxは4300→3800程度 (2)ここがよく分からないのですが、素人としては、１日何種類も品番を変えると ロスが多くなるので、「型A」「型B」は交互にするとしても、 出来るだけ同じ品番を沢山作る方がいいのではないかと思ったりするのですが、合ってますか？ それとも、交互生産になってさえいれば、１日に扱う品番の種類が多くなるのは大した問題じゃないのでしょうか？
■Ａ同一の品番を多く生産する方が効率はいいのですが、同一品番を連続4000作ると他の商品が在庫切れを起こしてしまうのです。 Ｂ品番の種類が多くなるとロスが多くなります。 ＡＢを鑑みてmax生産の中で市場に対応した最適の生産計画を組んでいます。それがほぼロット数と言うことになります。
＞ 6.メインライン生産数は頻繁に変更あり。イレギュラーも多いので、ハンド入力もokに (3)メインライン生産数(これは出荷数の意味ですよね）は元々手入力するデータだと理解しているのですが、あえて「ハンド入力もok」と書いた意味はなんですか？ 「何度でも再計算させたい」と言う意味と理解していいですか？
■メインサブラインとも多くの設備により生産しており、設備トラブルに対応するためです。 メインライン計画に基づいた算式でしか順列（表２）が決まるのではなく、ハンド入力でも作成可能にしたいという意味です。 しかしあらためて考えてみますと、日々作成する資料なのでそこまで必要ないようにも思えてきました。
＞ 8.在庫は5000～6000持てる (4)これも上記(1)の同じで、その範囲で持つのが理想なんですか？ それとも、その8割程度が居心地がいいのでしょうか？
■これは 「サブラインは1.5日程度在庫が持てるので、余裕を持った計画が組める」 「求めたい表２の順列はとてもシビアではない」 を表しています。 6000個が在庫を持てるmaxで日々maxの在庫を持っています。 生産能力（max生産）はサブラインの方が多いので日々余裕があります。
（セサミン） 2016/05/05(木) 11:53
現在、考慮中ですが、条件が込み入っていて、いいアイデアが浮かんで来ません。
泥臭くやるにしても、時間が掛かりそうです。気長にお待ちください。<(_ _)>
それまでに、他の方から回答が出るといいのですが・・・
（半平太） 2016/05/05(木) 21:57
半平太さん ご尽力いただきありがとうございます。 「この条件をしぼればできる」のようなことでも結構です。 またフォームの限定はないので、何らかの形で表２のようなものができれば結構です。 よろしくお願いします。
（セサミン） 2016/05/06(金) 11:51
ちょっと、テストしていて,おかしいなと思う点があるのですが、
サンプルによれば、下図の状態で希望通り、となるようですが、
＞2.max生産はメインライン4000、サブライン4300程度 ＞8.在庫は5000～6000持てる
との説明があり、生産や在庫のリミットをかなりオーバーすることになると思うのですが、 実際問題として、そんなにシビアな上限じゃないのですか？
少し多目くらいが、作業目標としてならちょうどいい、と言うことなんでしょうか？ （もしそうなら、プレッシャーがすごく薄らぐんですけど。）
行 __F__ __G__ __H__ __I__ 2 5/9 3 出荷 順列 生産 在庫 4 130 770 5 1,480 1 2,400 2,020 6 0 3 400 420 7 500 100 8 60 140 9 120 2 800 770 10 180 620 11 1,000 4 1,600 2,600 12 3,470 5,200 7,440 ←在庫合計 ↑ サブライン生産
（半平太） 2016/05/06(金) 12:45
はい、シビアではありません。 実際は下記に近い数値になると思います。 日々在庫が一杯になった時点で生産が終了しています。
行 __F__ __G__ __H__ __I__ 2 5/9 3 出荷 順列 生産 在庫 4 130 770 5 1,480 1 2,400 2,020 6 0 3 400 420 7 500 100 8 60 140 9 120 2 800 770 10 180 620 11 1,000 4 400 1,400 12 3,470 4,000 6,240 ←在庫合計 ↑ サブライン生産 （セサミン） 2016/05/06(金) 16:45
＜プログラムの流れ＞ 【表１ メインラインへの出荷】と表示されているB1セルを右クリックされると 「自動アサインを実行しますか？」と聞き、[OK]ボタンがクリックされると、 在庫欄と合計欄に数式を埋めてから、生産計画を算出する。
※その際、入力済みの「順列」と「生産列」は邪魔なので真っ先にクリアします。 何か書いていても無駄になりますのでご留意ください。
※強制的に数式を埋めるのは、既存の数式が何かの弾みで壊されていると、 正確に処理できないための "矯正" です。
最初に表１を埋め、そのデータを使って表２を作成します。 (したがって、質問とは逆の流れの処理になります）
＜ユーザーの操作手順＞ １．表１の手入力する個所(※)を全部埋める。
※「在庫(E)」と各日付ブロックの「出荷欄(I、M、Q、U）」くらいかと思います。 ※ 品番が増えたら、行を挿入して、B、C、D列の基本情報を埋めてください。 数式は、後でプログラムが自動的に埋ますので、他からコピーする必要はありません。
２．【表１ メインラインへの出荷】と表示されているB1セルを右クリックし、 「自動アサインを実行しますか？」と聞かれたら、[OK]ボタンをクリックする。
以上で、計画数量が、自動的に計算されます。（向こう4日分までです。サンプルだと5/12まで）
<投稿用>シート B1セル右クリック前 行 ___B___ _C_ ___D___ __E__ __F__ __G__ __H__ __I__ __J__ __K__ ___L___ ___M___ __N__ __O__ __P__ ___Q___ __R__ __S__ __T__ ___U___ 1 【表１ メインラインへの出荷】 5月8日 2 生産 5/8 5/9 5/10 5/11 5/12 3 品番 型 ロット 在庫 出荷 順列 生産 在庫 出荷 順列 生産 在庫 出荷 順列 生産 在庫 出荷 順列 生産 在庫 4 品番10 A 800 900 130 770 160 610 220 390 220 170 5 品番20 A 2,400 1,100 1,480 -380 1,600 -1,980 1,700 -3,680 1,700 -5,380 6 品番30 A 400 20 0 20 70 -50 70 -120 70 -190 7 品番40 A 1,600 600 500 100 500 -400 430 -830 430 -1,260 8 品番50 A 300 200 60 140 70 70 10 60 10 50 9 品番100 B 800 90 120 -30 300 -330 250 -580 250 -830 10 品番200 B 800 800 180 620 220 400 150 250 160 90 11 品番300 B 1,600 2,000 1,000 1,000 1,000 0 1,100 -1,100 1,100 -2,200 12 合計 5,710 3,470 0 2,240 3,920 0 -1,680 3,930 0 -5,610 3,940 0 -9,550
<投稿用>シート B1セル右クリック後 行 _____B_____ ___C___ ___D___ ___E___ ___F___ ____G____ __H__ __I__ __J__ __K__ ___L___ __M__ __N__ __O__ __P__ __Q__ __R__ __S__ __T__ __U__ 1 【表１ メインラインへの出荷】 5月8日 2 生産 5/8 5/9 5/10 5/11 5/12 3 品番 型 ロット 在庫 出荷 順列 生産 在庫 出荷 順列 生産 在庫 出荷 順列 生産 在庫 出荷 順列 生産 在庫 4 品番10 A 800 900 130 770 160 610 220 390 220 170 5 品番20 A 2,400 1,100 1,480 1 2,400 2,020 1,600 420 1,700 9 2,400 1,120 1,700 10 2,400 1,820 6 品番30 A 400 20 0 3 400 420 70 350 70 280 70 210 7 品番40 A 1,600 600 500 100 500 6 1,600 1,200 430 770 430 340 8 品番50 A 300 200 60 140 70 70 10 60 10 50 9 品番100 B 800 90 120 2 800 770 300 7 800 1,270 250 1,020 250 770 10 品番200 B 800 800 180 620 220 5 800 1,200 150 1,050 160 890 11 品番300 B 1,600 2,000 1,000 4 1,600 2,600 1,000 1,600 1,100 8 1,600 2,100 1,100 11 1,600 2,600 12 合計 5,710 3,470 5,200 7,440 3,920 3,200 6,720 3,930 4,000 6,790 3,940 4,000 6,850 13 14 【表２ サブライン生産台数】 15 翌日の生産 作成日 5月8日 16 順列 品番 型 数量 累計 17 1 品番20 A 2,400 2,400 2016/5/9 18 2 品番100 B 800 3,200 19 3 品番30 A 400 3,600 20 4 品番300 B 1,600 5,200 21 5 品番200 B 800 6,000 2016/5/10 22 6 品番40 A 1,600 7,600 23 7 品番100 B 800 8,400 24 8 品番300 B 1,600 10,000 2016/5/11 25 9 品番20 A 2,400 12,400 26 10 品番20 A 2,400 14,800 2016/5/12 27 11 品番300 B 1,600 16,400
＜プログラムの貼り付け＞
(1)「投稿用シート」のシートモジュールに
↓
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address <> "$B$1" Then
Exit Sub
ElseIf MsgBox("自動アサインを実行しますか？", vbYesNo) = vbYes Then
Cancel = True
Call 生産量算出
End If
End Sub
(2)標準モジュールに ↓
Enum MC 'マスタブロックの列番
品番 = 1
型AB = 2
ロット = 3
在庫 = 4
End Enum
Enum DC '計画ブロックの列番
出荷 = 1
順列 = 2
生産 = 3
在庫 = 4
End Enum
Const MainMax As Long = 4000 Const 型交互Max As Long = 4300 Const 型連続Max As Long = 3800 '実際には使用しない Const 在庫Max As Long = 6000
Sub 生産量算出()
Dim WshSJL As Worksheet
Dim topRow As Long, btmRow As Long
Dim rowNO As Long, colNo As Long
Dim NN As Long, KK As Long, numKinds As Long
Dim blockNo As Long '翌日、翌々日・・
Dim minLot, balToReplenish
Dim Produ '生産数
Dim Bal '在庫
Dim 行番生産 '行番号と生産数を格納
Dim 配列定数 '並べ替えに使用
Dim 判定
Dim next型番 As String
Dim MSTrng As Range 'マスタの範囲
Dim MSTval As Variant
Dim BLKrng As Range '考慮対象日の範囲
Dim BLKval As Variant
Dim BLKno As Long
Dim BLKdate
Dim goNextBlock As Boolean
Dim 順列 As Long '処理順位
Dim SubLineAry(1 To 500, 1 To 6)
Dim DispRow As Long
Set WshSJL = ThisWorkbook.Sheets("投稿用")
topRow = Application.Match("品番", WshSJL.Columns(2), 0) + 1
btmRow = Application.Match("合計", WshSJL.Columns(2), 0)
numKinds = btmRow - topRow '品種数(合計行は含まない)
Set MSTrng = WshSJL.Range("B" & topRow).Resize(numKinds, 4)
MSTval = MSTrng.Value
' Set rngData = WshSJL.Range("B" & topRow).Resize(numKinds, 4 * 5)
配列定数 = Application.Transpose(Evaluate("Row(A1:A" & numKinds & ")"))
'数式を書き込む
With WshSJL
.Cells(btmRow, "E").Resize(1, 17).FormulaR1C1Local = "=SUM(R[-" & numKinds & "]C:R[-1]C)"
For NN = 0 To 3
.Cells(topRow, "I").Offset(, NN * 4).Resize(numKinds, 1).FormulaR1C1Local = "=RC[-4]-RC[-3]+RC[-1]"
.Cells(btmRow, "G").Offset(, NN * 4).ClearContents
Next NN
End With
順列 = 0 '初期化
DispRow = 0
'順次、考慮対象日の範囲を処理
For BLKno = 1 To 4 '４日分を処理
goNextBlock = False
Set BLKrng = MSTrng.Offset(0, BLKno * 4)
BLKdate = BLKrng.Cells(1).Offset(-2).Value
'順列と生産列をクリアする
BLKrng.Columns("B:C").ClearContents
Do Until goNextBlock 'キャパシティーオーバーまで反復実行
Set BLKrng = MSTrng.Offset(0, BLKno * 4) '順列反映後、再取得
BLKval = BLKrng.Value
If next型番 = "" Then '未定状態なら
next型番 = get型番(BLKval, numKinds, MSTval) '初期化
Else
next型番 = IIf(next型番 = "A", "B", "A")
End If
'生産余力・在庫余力の有無を判定する
判定 = 生産在庫余力(WshSJL, BLKrng) 'マイナスの個数→B交互生産数→連続→在庫オーバー
If 判定(1, 1) = 0 Then 'マイナスは無い
If 判定(1, 2) <= 0 Or _
判定(1, 4) <= 0 Then '在庫余力が無い
goNextBlock = True
Exit Do
End If
End If
行番生産 = 最優先行番(BLKval, numKinds, MSTval, 配列定数, next型番)
'結果をシート状に反映
BLKrng.Cells(行番生産(1, 1), DC.生産).Value = 行番生産(1, 2)
順列 = 順列 + 1
BLKrng.Cells(行番生産(1, 1), DC.順列).Value = 順列
'最終結果図配列へ格納
DispRow = DispRow + 1
SubLineAry(DispRow, 1) = 順列 '作業順
SubLineAry(DispRow, 2) = MSTval(行番生産(1, 1), MC.品番)
SubLineAry(DispRow, 3) = MSTval(行番生産(1, 1), MC.型AB)
SubLineAry(DispRow, 4) = 行番生産(1, 2) '生産量
If DispRow > 1 Then
SubLineAry(DispRow, 5) = SubLineAry(DispRow - 1, 5) + SubLineAry(DispRow, 4) '累計
Else
SubLineAry(DispRow, 5) = SubLineAry(DispRow, 4) '初行
SubLineAry(DispRow, 6) = BLKdate
End If
SubLineAry(DispRow, 6) = BLKdate
Loop
Next BLKno
'サブライン図の整形
Call SulineDisp(SubLineAry, WshSJL, btmRow + 2) 'タイトルをセット
End Sub
Function 生産在庫余力(WshSJL, BLKrng) 'マイナス個数→産交→産連→在余
Dim Produ, Bal
Dim 生産余力交互
Dim 生産余力連続
Dim 在庫積増余力
Dim CheckPoints
'当該ブロックの生産量合計と在庫合計をチェック
Produ = BLKrng(BLKrng.Cells.Count).Offset(1, -1).Value '生産計
Bal = BLKrng(BLKrng.Cells.Count).Offset(1, 0).Value '在庫計
生産余力交互 = 型交互Max - Produ
生産余力連続 = 型連続Max - Produ
在庫積増余力 = 在庫Max - Bal
ReDim CheckPoints(1 To 1, 1 To 4)
CheckPoints(1, 1) = Application.CountIf(BLKrng.Columns(DC.在庫), "<0")
CheckPoints(1, 2) = 生産余力交互
CheckPoints(1, 3) = 生産余力連続
CheckPoints(1, 4) = 在庫積増余力
生産在庫余力 = CheckPoints
End Function
Function get型番(vAry, Num, mAry)
Dim NN As Long
Dim minusA As Long, minusB As Long
For NN = 1 To Num
If vAry(NN, DC.在庫) < 0 Then
If UCase(mAry(NN, MC.型AB)) = "A" Then
minusA = minusA + 1
Else
minusB = minusB + 1
End If
End If
Next NN
If minusB > minusA Then
get型番 = "B"
Else
get型番 = "A"
End If
End Function
Function 最優先行番(vAry, Num, mAry, 配列定数, next型番)
Dim rowNO As Long, minLot As Double, Bal As Double
Dim balToReplenish As Double
Dim baseOrder, 参考情報(), NN As Long, 待ち行列(), 最優先()
ReDim 参考情報(1 To Num, 1 To 3) '初期化。順番；型→生産可能ロット→比率→順位
ReDim 比率(1 To Num, 1 To 1) '初期化。比率(生産可能ロット/在庫）
ReDim 待ち行列(1 To Num, 1 To 2) '初期化。型→行番号(上から昇順）
ReDim 最優先(1 To 1, 1 To 2)
For rowNO = 1 To Num
minLot = mAry(rowNO, MC.ロット)
Bal = vAry(rowNO, DC.在庫)
If Bal < 0 Then
With Application
balToReplenish = .Max(minLot, .Ceiling(-Bal, _
IIf(mAry(Num, MC.型AB) = "品番50", 300, 400)))
End With
ElseIf vAry(rowNO, DC.生産) > 0 Then
balToReplenish = IIf(mAry(Num, MC.型AB) = "品番50", 300, 400)
Else
balToReplenish = minLot
End If
'優先順位を決定する
参考情報(rowNO, 1) = mAry(rowNO, MC.型AB)
参考情報(rowNO, 2) = balToReplenish
比率(rowNO, 1) = vAry(rowNO, DC.在庫) / 参考情報(rowNO, 2) _
+ rowNO * 0.0000000001 '同率を避ける
Next rowNO
baseOrder = Application.Small(比率, 配列定数)
For NN = 1 To Num
参考情報(NN, 3) = Application.Match(比率(NN, 1), baseOrder, 0) '順位
待ち行列(参考情報(NN, 3), 1) = 参考情報(NN, 1) '型ABを格納する
待ち行列(参考情報(NN, 3), 2) = NN '順位ポジションに該当する行番号を格納する
Next NN
For NN = 1 To Num
If 待ち行列(NN, 1) = next型番 Then
最優先(1, 1) = 待ち行列(NN, 2) '採用すべき行番号が決定
Exit For
End If
Next NN
If 最優先(1, 1) = "" Then '型番ABに交互にできない
For NN = 1 To Num
If 待ち行列(NN, 1) <> next型番 Then
最優先(1, 1) = 待ち行列(NN, 2) '採用すべき行番号が決定
Exit For
End If
Next NN
End If
If 最優先(1, 1) = "" Then
Stop 'ありえない
Else
最優先(1, 2) = 参考情報(最優先(1, 1), 2)
End If
最優先行番 = 最優先
End Function
Private Sub SulineDisp(SubLineAry, WshSJL, topNumToClear)
Dim NN As Long, FirstDay
'タイトル
With WshSJL
.Cells(topNumToClear, "A").Resize(200, 7).ClearContents
Rem 生データのセルをまとめて処理
.Cells(topNumToClear + 0, "B").Value = "【表２ サブライン生産台数】"
.Cells(topNumToClear + 1, "B").Value = "翌日の生産"
' .Cells(topNumToClear + 1, "B").Resize(1, 2).HorizontalAlignment = xlCenterAcrossSelection
.Cells(topNumToClear + 1, "D").Value = "作成日"
.Cells(topNumToClear + 1, "E").Value = .Range("L1") '日付
.Cells(topNumToClear + 1, "E").NumberFormatLocal = "m""月""d""日"""
.Cells(topNumToClear + 1, "E").Resize(1, 2).HorizontalAlignment = xlCenterAcrossSelection
.Cells(topNumToClear + 2, "B").Resize(1, 5) = [{"順列","品番","型","数量","累計"}]
.Cells(topNumToClear + 3, "B").Resize(UBound(SubLineAry), UBound(SubLineAry, 2)).Value = SubLineAry
For NN = topNumToClear + 3 To 300
If NN = topNumToClear + 3 Then
FirstDay = .Cells(NN, "G").Value
ElseIf .Cells(NN, "G").Value = "" Then
Exit For
ElseIf NN = 1 Then
FirstDay = .Cells(NN, "G").Value
ElseIf FirstDay = .Cells(NN, "G").Value Then
.Cells(NN, "G").Value = ""
Else
FirstDay = .Cells(NN, "G").Value
End If
Next NN
End With
End Sub
’以上(2)終わり
（半平太） 2016/05/06(金) 21:14
ありがとうございます！ うまく動きました。 生産ロットの変更にも対応していただいているようで嬉しいです。 とても長いプログラムで、何か大変なことをお願いしてしまったのかと恐縮しています。
いろいろテストをした中で質問＆お願いです。 1.サブラインmax生産値の変更はこの行を書きかえればよろしいですか？ Const 型交互Max As Long = 4300
2.出荷数F5を500 F11を200にすると、当日生産計H12は2000になります。 生産はmax4300なので4300を超えるまで5/9に生産を入れたいです。 順列G5を4 生産H5を2400 とし、H12は4400としたいのですが…。
3.表２.21行目が累計6000のところで5/10となっています。 この日付は4300（max値）越えたごと（20行目）に生産日を表示したいのですが…。
17 1 品番20 A 2,400 2,400 2016/5/9 18 2 品番100 B 800 3,200 19 3 品番30 A 400 3,600 20 4 品番300 B 1,600 5,200 21 5 品番200 B 800 6,000 2016/5/10
4.表２ 順列4・5 順列7・8 順列11・12 型が連続しています。 条件のところに詳しく書いておくべきでしたが、型の連続は生産ロスが発生するので極力避けたいと思います。 「5/9・10生産を埋め、5/10に尚マイナスがあれば連続生産も許可」にできませんでしょうか？ もし不可なら「交互生産のみ」でお願いします。
5.生産の優先順位はどのように判断しているのでしょうか？ 現状も明確な基準はなく、在庫の少ない順（マイナスが多い順）を基本にして都度判断しています。 ・品番ごとのロット数が大きく違うし、在庫が少なくても数日生産がないケースがあります。 ・あまり先の在庫推移を見ても明日切れては困ります。 どう考えれば論理的かよろしければご意見をお聞かせ下さい。
（セサミン） 2016/05/07(土) 09:35
今、出先で検証できないのですが 2はもしかしたら在庫数で制御しているのでしょうか？ であれば任意の数値に変更できますでしょうか （セサミン） 2016/05/07(土) 10:54
在庫上限はここで制御でしょうか。 Const 在庫Max As Long = 6000
（セサミン） 2016/05/08(日) 14:43
＞1.サブラインmax生産値の変更はこの行を書きかえればよろしいですか？ ＞ Const 型交互Max As Long = 4300
１．それでOKです。
＞ 2.出荷数F5を500 F11を200にすると、当日生産計H12は2000になります。 ＞ 生産はmax4300なので4300を超えるまで5/9に生産を入れたいです。 ＞ 順列G5を4 生産H5を2400 とし、H12は4400としたいのですが…。
２-(1) そうなるロジックを開示して頂かないと何ともなりません。
後記５で、当方のロジックを解説していますが、 優先順は以下の比率に従って決定しています。 (但し、A型から強制スタート、A/B型強制交互、在庫上限を撤廃後の場合)
___B___ _C_ ___D___ __E__ __F__ __G__ __H__ __I__ 品番 型 ロット 在庫 出荷 順列 生産 在庫 比率 優先順 品番10 A 800 900 130 770 96% 品番20 A 2,400 1,100 500 600 25% ５←Aの3番 品番30 A 400 20 0 20 5% １←Aの1番 品番40 A 1,600 600 500 100 6% ３←Aの2番 品番50 A 300 200 60 140 47%
品番100 B 800 90 120 -30 -4% ２←Bの1番 品番200 B 800 800 180 620 78% ４←Bの2番 品番300 B 1,600 2,000 200 1,800 113%
なので結果としては、以下になります。 <結果図> ___B___ _C_ ___D___ __E__ __F__ __G__ __H__ __I__ 品番 型 ロット 在庫 出荷 順列 生産 在庫 品番10 A 800 900 130 770 品番20 A 2,400 1,100 500 5 2,400 3,000 品番30 A 400 20 0 1 400 420 品番40 A 1,600 600 500 3 1,600 1,700 品番50 A 300 200 60 140 品番100 B 800 90 120 2 800 770 品番200 B 800 800 180 4 800 1,420 品番300 B 1,600 2,000 200 1,800
＞ 2はもしかしたら在庫数で制御しているのでしょうか？
２-(2) その通りです。
＞であれば任意の数値に変更できますでしょうか どこに書くか決める必要があります。
当然、どんな状況で上限を変更したいか、によりますけど・・・、 頻繁に変更するが、上限自体は１つなら、 シート上のどこかのセルに１つ入力する。
日によって違う上限にしたいなら、4つのセルに入力する。
単に、質問文に書いた在庫上限が間違っていたに近いニュアンスなら、 プログラムに直接書く(訂正する）ことになります。
ところが・・です。 後段の要望も考慮すると、出荷・生産しか関係ないと言う気がしているんですけど。 ならば、在庫制限は外した方がいいんじゃないですか？
ただ、それに伴って、ロジックも見直すのはちょっと怖いので、 これを実質青天井(6000→100000）に変えちゃえばいいかな・・・と、 ↓ ※Const 在庫Max As Long = 6000
＞ 3.表２.21行目が累計6000のところで5/10となっています。 ＞ この日付は4300（max値）越えたごと（20行目）に生産日を表示したいのですが…。
３．ありゃ！ 表２は、そう見るものなんですか？
そうなると、生産上限は、1日目が4300、2日目が(累計で）8600、・・・、と言うロジックで 表１も作らないとならなかったことになります。
何故なら、当日の生産未達量を翌日の生産計画に加算しないとならないので。
すると、その数量分だけ翌日の生産量は抑えられることになります。それが理屈ですよね？
＞ 4.表２ 順列4・5 順列7・8 順列11・12 型が連続しています。 ＞ 条件のところに詳しく書いておくべきでしたが、型の連続は生産ロスが発生するので極力避けたいと思います。 ＞ 「5/9・10生産を埋め、5/10に尚マイナスがあれば連続生産も許可」にできませんでしょうか？ ＞ もし不可なら「交互生産のみ」でお願いします。
４．もともと、交互生産を前提に書いていたのですが、 一日毎にそうなればいいのかなと思ったので、深く注意していませんでした。
これは簡単に修正できます。
ただ、プログラムの運用を開始時のことに想いを馳せると、 １番目をどの型からスタートするか指定できないと困ることになります。
何故なら、前日の終わりがA/Bどちらかだったか正しく エクセルに認識させないとならないからです。(勝手にエクセルが決めたら現実に困る）
そこで、「合計」の直下に翌日のスタート型を指定して頂くことにしたいと思います。
<サンプル>
____B____ _C_
合計
翌日開始 A ←翌日(5/9）はA型から始めると指定する場合
※合計の右下のセルに何も指定しないと(それは有り得ないと思っていますが） マイナス在庫の型数が多い方から始まる作りになっています。
＞ 5.生産の優先順位はどのように判断しているのでしょうか？ ＞ 現状も明確な基準はなく、在庫の少ない順（マイナスが多い順）を基本にして都度判断しています。 ＞ ・品番ごとのロット数が大きく違うし、在庫が少なくても数日生産がないケースがあります。 ＞ ・あまり先の在庫推移を見ても明日切れては困ります。 ＞ どう考えれば論理的かよろしければご意見をお聞かせ下さい。
５．比率です。比率は「在庫/ロット」で算出します。 単に在庫が少ないとかで決めると、 もともと在庫が少なくていい型番も生産対象になっちゃいます。
なので、ロット当たりで計算して、小さい方を優先して生産させる方式です。 (マイナスは当然小さい方に入るので、自然体で優先度が高くなります） いずれにしても、A/B交互に生産していって、マイナスが解消するまでは、 生産能力を超えようとも生産計画に計上します。
まぁ、そうなると、物理的に無理な数値も算出されることもあるでしょうが、その時は 出荷計画の方を人間が調整することになるでしょうね。
素人考えでは、マイナス残と言うより、危険ライン残のような概念を使う余地も あるんじゃないかと思っていますが、実際問題どんなものなのか判断つきません。
そんなこんなを修正すると、以下のコードになります。 標準モジュールを全とっかえしてください。
結果はこんな風です。 ↓ <投稿用>シート 行 _____B_____ ___C___ ___D___ ___E___ ___F___ ______G______ __H__ ___I___ 1 【表１ メインラインへの出荷】 2 生産 5/8 5/9 3 品番 型 ロット 在庫 出荷 順列 生産 在庫 4 品番10 A 800 900 130 770 5 品番20 A 2,400 1,100 500 5 2,400 3,000 6 品番30 A 400 20 0 1 400 420 7 品番40 A 1,600 600 500 3 1,600 1,700 8 品番50 A 300 200 60 140 9 品番100 B 800 90 120 2 800 770 10 品番200 B 800 800 180 4 800 1,420 11 品番300 B 1,600 2,000 200 1,800 12 合計 5,710 1,690 6,000 10,020 13 翌日開始 A 14 15 【表２ サブライン生産台数】 16 翌日の生産 作成日 5月8日 17 順列 品番 型 数量 累計 18 1 品番30 A 400 400 2016/5/9 19 2 品番100 B 800 1,200 20 3 品番40 A 1,600 2,800 21 4 品番200 B 800 3,600 22 5 品番20 A 2,400 6,000 2016/5/10 23 6 品番300 B 1,600 7,600 24 7 品番50 A 300 7,900 25 8 品番100 B 800 8,700 2016/5/11 26 9 品番20 A 2,400 11,100 27 10 品番300 B 1,600 12,700 28 11 品番40 A 1,600 14,300 2016/5/12 29 12 品番100 B 800 15,100 30 13 品番20 A 2,400 17,500 翌日持ち越し
’標準モジュールに再貼り付けするコード(全面取替えベース）
Option Explicit
Enum MC 'マスタブロックの列番
品番 = 1
型AB = 2
ロット = 3
在庫 = 4
End Enum
Enum DC '計画ブロックの列番
出荷 = 1
順列 = 2
生産 = 3
在庫 = 4
End Enum
Const MainMax As Long = 4000 Const 型交互Max As Long = 4300 Const 型連続Max As Long = 3800 '実際には使用しない Const 在庫Max As Long = 100000 '実質青天井
Sub 生産量算出()
Dim WshSJL As Worksheet
Dim topRow As Long, btmRow As Long
Dim rowNO As Long, colNo As Long
Dim NN As Long, KK As Long, numKinds As Long
Dim blockNo As Long '翌日、翌々日・・
Dim minLot, balToReplenish
Dim Produ '生産数
Dim Bal '在庫
Dim 行番生産 '(1)行番号と(2）生産数
Dim 配列定数 '並べ替えに使用
Dim Limit判定
Dim next型番 As String
Dim MSTrng As Range 'マスタの範囲
Dim MSTval As Variant
Dim BLKrng As Range '考慮対象日の範囲
Dim BLKval As Variant
Dim BLKno As Long
Dim BLKdate
Dim goNextBlock As Boolean
Dim 順列 As Long '処理順位
Dim checkPoint(1 To 10, 1 To 2) '生産上限→日付
Dim yesNewFace As Boolean
Dim SubLineAry(1 To 500, 1 To 6)
Dim dispRow As Long
Set WshSJL = ThisWorkbook.Sheets("投稿用")
topRow = Application.Match("品番", WshSJL.Columns(2), 0) + 1
btmRow = Application.Match("合計", WshSJL.Columns(2), 0)
numKinds = btmRow - topRow '品種数(合計行は含まない)
Set MSTrng = WshSJL.Range("B" & topRow).Resize(numKinds, 4)
MSTval = MSTrng.Value
' Set rngData = WshSJL.Range("B" & topRow).Resize(numKinds, 4 * 5)
配列定数 = Application.Transpose(Evaluate("Row(A1:A" & numKinds & ")"))
'日ごとの生産上限と日付を格納 (1)生産上限→(2)日付
For NN = 1 To 10
checkPoint(NN, 1) = 型交互Max * NN
checkPoint(NN, 2) = WshSJL.Cells(2, "F").Offset(, (NN - 1) * 4).Value
Next NN
next型番 = IIf(WshSJL.Cells(btmRow + 1, "C").Value = "A", "B", "A") '後で入れ替わるので反対を格納する
'数式を書き込む
With WshSJL
.Cells(btmRow, "E").Resize(1, 17).FormulaR1C1Local = "=SUM(R[-" & numKinds & "]C:R[-1]C)"
For NN = 0 To 3
.Cells(topRow, "I").Offset(, NN * 4).Resize(numKinds, 1).FormulaR1C1Local = "=RC[-4]-RC[-3]+RC[-1]"
.Cells(btmRow, "G").Offset(, NN * 4).ClearContents
Next NN
End With
順列 = 0 '初期化
dispRow = 0
'順次、考慮対象日の範囲を処理
For BLKno = 1 To 4 '４日分を処理
goNextBlock = False
Set BLKrng = MSTrng.Offset(0, BLKno * 4)
BLKdate = BLKrng.Cells(1).Offset(-2).Value
'順列と生産列をクリアする
BLKrng.Columns("B:C").ClearContents
Do Until goNextBlock 'キャパシティーオーバーまで反復実行
Set BLKrng = MSTrng.Offset(0, BLKno * 4) '順列反映後、再取得
BLKval = BLKrng.Value
'生産余力・在庫余力の有無をLimit判定する
Limit判定 = 生産在庫余力(WshSJL, btmRow, BLKrng, MSTrng, BLKno) 'マイナスの個数→B交互生産数→連続→在庫オーバー
If Limit判定(1, 1) = 0 Then 'マイナスは無い
If Limit判定(1, 2) <= 0 Or _
Limit判定(1, 4) <= 0 Then '在庫余力が無い
goNextBlock = True
Exit Do
End If
End If
'型番を交互になる様にする
If next型番 = "" Then '未定状態なら
next型番 = get型番(BLKval, numKinds, MSTval) '初期化
Else
next型番 = IIf(next型番 = "A", "B", "A")
End If
行番生産 = 最優先行番(BLKval, numKinds, MSTval, 配列定数, next型番)
'追加生産に該当するかチェック
yesNewFace = (BLKrng.Cells(行番生産(1, 1), DC.順列).Value = "")
'結果をシート上に加算
BLKrng.Cells(行番生産(1, 1), DC.生産).Value = _
BLKrng.Cells(行番生産(1, 1), DC.生産).Value + 行番生産(1, 2)
'既に生産数が入っていない場合のみ以下を処理
If yesNewFace Then
順列 = 順列 + 1
BLKrng.Cells(行番生産(1, 1), DC.順列).Value = 順列
Else '再度同じ型に取り掛かるために、next型番を元に戻す
next型番 = IIf(next型番 = "A", "B", "A")
End If
Loop
'表２へ転記
If BLKno = 1 Then
Call dispTitle(SubLineAry, WshSJL, btmRow + 3)
End If
dispRow = WshSJL.Cells(Rows.Count, "B").End(xlUp).Row
For NN = 1 To numKinds
If BLKrng.Cells(NN, DC.順列) <> "" Then
dispRow = dispRow + 1
WshSJL.Cells(dispRow, "B").Resize(, 6).Value = _
Array(BLKrng.Cells(NN, DC.順列), MSTrng(NN, MC.品番), _
MSTrng(NN, MC.型AB), BLKrng.Cells(NN, DC.生産), Empty, BLKdate)
End If
Next NN
Next BLKno
'順列で並べ替え
With WshSJL
.Cells(btmRow + 5, "B").Resize(300, 6).Sort _
Key1:=Range("B1"), order1:=xlAscending, Header:=xlYes
'累計算出
For NN = btmRow + 6 To 300
If .Cells(NN, "B").Value = Empty Then
Exit For
ElseIf NN = btmRow + 6 Then
.Cells(NN, "F").Value = .Cells(NN, "E").Value
Else
.Cells(NN, "F").Value = .Cells(NN - 1, "F").Value + .Cells(NN, "E").Value
End If
Next NN
End With
'日付表示を調整
Call SubLineDisp(WshSJL, btmRow + 3, checkPoint)
End Sub
Function 生産在庫余力(WshSJL, btmRow, BLKrng, MSTrng, BLKno) 'マイナス個数→産交→産連→在余
Dim Produ, Bal
Dim NN As Long
Dim 生産余力交互
Dim 生産余力連続
Dim 在庫積増余力
Dim CheckPoints
'当該ブロックの生産量累計と在庫合計をチェック
For NN = 1 To BLKno
Produ = Produ + WshSJL.Cells(btmRow, 4 + NN * 4).Value '生産累計
Next NN
Bal = BLKrng(BLKrng.Cells.Count).Offset(1, 0).Value '在庫計(これは元々成り行きベース)
生産余力交互 = 型交互Max * BLKno - Produ
生産余力連続 = 型連続Max * BLKno - Produ
在庫積増余力 = 在庫Max - Bal
ReDim CheckPoints(1 To 1, 1 To 4)
CheckPoints(1, 1) = Application.CountIf(BLKrng.Columns(DC.在庫), "<0")
CheckPoints(1, 2) = 生産余力交互
CheckPoints(1, 3) = 生産余力連続
CheckPoints(1, 4) = 在庫積増余力
生産在庫余力 = CheckPoints
End Function
Function get型番(vAry, Num, mAry)
Dim NN As Long
Dim minusA As Long, minusB As Long
For NN = 1 To Num
If vAry(NN, DC.在庫) < 0 Then
If UCase(mAry(NN, MC.型AB)) = "A" Then
minusA = minusA + 1
Else
minusB = minusB + 1
End If
End If
Next NN
If minusB > minusA Then
get型番 = "B"
Else
get型番 = "A"
End If
End Function
Function 最優先行番(vAry, Num, mAry, 配列定数, next型番)
Dim rowNO As Long, minLot As Double, Bal As Double, NN As Long
Dim balToReplenish As Double
Dim baseOrder, 参考情報(), 比率(), 待ち行列()
Dim 最優先(1 To 1, 1 To 2) '採用行番→生産量
ReDim 参考情報(1 To Num, 1 To 3) '初期化。順番；型→生産可能ロット→比率→順位
ReDim 比率(1 To Num, 1 To 1) '初期化。比率(生産可能ロット/在庫）
ReDim 待ち行列(1 To Num, 1 To 2) '初期化。型→行番号(上から昇順）
For rowNO = 1 To Num
minLot = mAry(rowNO, MC.ロット)
Bal = vAry(rowNO, DC.在庫)
If Bal < 0 Then '在庫マイナスのケース
With Application
balToReplenish = .Max(minLot, _
.Ceiling(-Bal, IIf(mAry(rowNO, MC.品番) = "品番50", 300, 400))) '型番別生産量算出
End With
ElseIf vAry(rowNO, DC.生産) > 0 Then '既に生産量が埋まっているケースなのでminLotは無縁
balToReplenish = IIf(mAry(rowNO, MC.品番) = "品番50", 300, 400) '型番別生産量算出
Else
balToReplenish = minLot
End If
'優先順位を決定する
参考情報(rowNO, 1) = mAry(rowNO, MC.型AB)
参考情報(rowNO, 2) = balToReplenish
比率(rowNO, 1) = vAry(rowNO, DC.在庫) / 参考情報(rowNO, 2) _
+ rowNO * 0.0000000001 '同率を避ける
Next rowNO
baseOrder = Application.Small(比率, 配列定数)
For NN = 1 To Num
参考情報(NN, 3) = Application.Match(比率(NN, 1), baseOrder, 0) '順位
待ち行列(参考情報(NN, 3), 1) = 参考情報(NN, 1) '型ABを格納する
待ち行列(参考情報(NN, 3), 2) = NN '順位ポジションに該当する行番号を格納する
Next NN
For NN = 1 To Num
If 待ち行列(NN, 1) = next型番 Then
最優先(1, 1) = 待ち行列(NN, 2) '採用すべき行番号が決定
Exit For
End If
Next NN
If 最優先(1, 1) = "" Then '型番ABに交互にできない
For NN = 1 To Num
If 待ち行列(NN, 1) <> next型番 Then
最優先(1, 1) = 待ち行列(NN, 2) '採用すべき行番号が決定
Exit For
End If
Next NN
End If
If 最優先(1, 1) = "" Then
Stop 'ありえない
Else
最優先(1, 2) = 参考情報(最優先(1, 1), 2)
End If
最優先行番 = 最優先
End Function
Private Sub dispTitle(SubLineAry, WshSJL, topNumToClear)
With WshSJL
.Cells(topNumToClear, "A").Resize(200, 7).ClearContents
Rem 生データのセルをまとめて処理
.Cells(topNumToClear + 0, "B").Value = "【表２ サブライン生産台数】"
.Cells(topNumToClear + 1, "B").Value = "翌日の生産"
.Cells(topNumToClear + 1, "D").Value = "作成日"
.Cells(topNumToClear + 1, "E").Value = .Range("L1") '日付
.Cells(topNumToClear + 1, "E").NumberFormatLocal = "m""月""d""日"""
.Cells(topNumToClear + 1, "E").Resize(1, 2).HorizontalAlignment = xlCenterAcrossSelection
.Cells(topNumToClear + 2, "B").Resize(1, 5) = [{"順列","品番","型","数量","累計"}]
.Cells(topNumToClear + 3, "B").Resize(UBound(SubLineAry), UBound(SubLineAry, 2)).Value = SubLineAry
End With
End Sub
Private Sub SubLineDisp(WshSJL, topNumToClear, checkPoint)
Dim NN As Long, MileStone As Long
With WshSJL
MileStone = 1
For NN = topNumToClear + 3 To 300
If .Cells(NN, "G").Value = "" Then
Exit For
ElseIf .Cells(NN, "F").Value > checkPoint(MileStone, 1) Then '生産上限越え
If MileStone >= 4 Then
.Cells(NN, "G").Value = "翌日持ち越し"
Exit For
Else
.Cells(NN, "G").Value = checkPoint(MileStone + 1, 2) '翌日を入力
MileStone = MileStone + 1
End If
ElseIf NN = topNumToClear + 3 Then
.Cells(NN, "G").Value = checkPoint(MileStone, 2) '初日入力
Else
.Cells(NN, "G").Value = ""
End If
Next NN
End With
End Sub
（半平太） 2016/05/08(日) 15:21
> これを実質青天井(6000→100000）に変えちゃえばいいかな・・・と、 > ↓ > ※Const 在庫Max As Long = 6000 調整できるように条件を書いておけばよかったことに今さら気づきました。ここで調整します。
> 何故なら、当日の生産未達量を翌日の生産計画に加算しないとならないので。 > すると、その数量分だけ翌日の生産量は抑えられることになります。それが理屈ですよね？ そうです。
> そこで、「合計」の直下に翌日のスタート型を指定して頂くことにしたいと思います。 そういう方法がありましたか…。日々交互生産しているのでその必要性に気付きませんでした。
> ５．比率です。比率は「在庫/ロット」で算出します。 納得です。
メインサブともmax生産が連続することは少ないので、 こうして質問したりご教示いただく中で現在の仕組みを深く理解することができました。 長時間ご尽力いただきありがとうございました。
（セサミン） 2016/05/08(日) 19:37
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.