麻辣家族討論版版 - Powered by Discuz! Board

標題: 每日總量限制 [打印本頁]

作者: 52ee24 時間: 2020-5-13 20:22 標題: 每日總量限制

各位前輩好
我的需求是要把WIP(Sheet)各製程的排程日期
整理到排程(sheet)裡
各製程的每日生產總量不固定
資料非常多
我的想法是比對排程裡的每日總數量
超過每日生產總量的話就順排至下一天
還要避開星期天
因為我只會用迴圈寫
一直順推
都會累積到某一天(例如圖一)
例:
排程(sheet)的01雷射清洗前_站
每日生產總量是2200
先依據WIP(sheet)DL欄位日期
把A欄_批號資料帶入對應的排程日期裡
帶入時比對已經排入的總數
超過的就被入隔天
程式如下
'01雷射清洗前
      For j = 2 To r1
      dl = Sheets("WIP").Range("dl" & j)
      If dl <> "" Then
      lot = Sheets("WIP").Range("a" & j)

         '找製程別
         Dim c As Range
         Set c = Sheets("排程").Range("b:b")
         fnd = c.Find(what:="01雷射清洗前", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Row

'
         '找日期欄
         Dim c1 As Range
         Set c1 = Sheets("排程").Range("a1:cfm1")
         fnd1 = c1.Find(what:=dl, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Column
         '找日期列
         Dim c2 As Range
         Set c2 = Sheets("排程").Columns(fnd1)
         fnd2 = c2.Find(what:="", after:=Cells(1, fnd1), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Row
            plus = Cells(fnd, fnd1 - 2)
            If plus < 2000 Then
            Cells(fnd2, fnd1) = lot

                  plus1 = Cells(fnd, fnd1 + 7)
                  ElseIf plus1 < 2000 Then
                  Dim c3 As Range
                  Set c3 = Sheets("排程").Columns(fnd1 + 8)
                  fnd3 = c3.Find(what:="", after:=Cells(1, fnd1 + 8), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Row
                  Cells(fnd3, fnd1 + 8) = lot

                     plus2 = Cells(fnd, fnd1 + 15)
                     ElseIf plus2 < 2000 Then
                     Dim c4 As Range
                     Set c4 = Sheets("排程").Columns(fnd1 + 16)
                     fnd4 = c4.Find(what:="", after:=Cells(1, fnd1 + 16), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Row
                     Cells(fnd4, fnd1 + 16) = lot
                        plus3 = Cells(fnd, fnd1 + 23)
                        ElseIf plus3 < 2000 Then
                        Dim c5 As Range
                        Set c5 = Sheets("排程").Columns(fnd1 + 24)
                        fnd5 = c5.Find(what:="", after:=Cells(1, fnd1 + 24), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Row
                        Cells(fnd5, fnd1 + 24) = lot
                        plus4 = Cells(fnd, fnd1 + 31)
                        ElseIf plus4 < 2000 Then
                        Dim c6 As Range
                        Set c6 = Sheets("排程").Columns(fnd1 + 32)
                        fnd6 = c6.Find(what:="", after:=Cells(1, fnd1 + 32), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Row
                        Cells(fnd6, fnd1 + 32) = lot
                        plus5 = Cells(fnd, fnd1 + 39)
                        ElseIf plus5 < 2000 Then
                        Dim c7 As Range
                        Set c7 = Sheets("排程").Columns(fnd1 + 40)
                        fnd7 = c7.Find(what:="", after:=Cells(1, fnd1 + 40), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Row
                        Cells(fnd7, fnd1 + 40) = lot
                        plus6 = Cells(fnd, fnd1 + 47)
                        ElseIf plus6 < 2000 Then
                        Dim c8 As Range
                        Set c8 = Sheets("排程").Columns(fnd1 + 48)
                        fnd8 = c8.Find(what:="", after:=Cells(1, fnd1 + 48), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Row
                        Cells(fnd8, fnd1 + 48) = lot
                     Else


               End If

      End If
      Next j

請各位幫幫忙了!!!!
搞不出來
會被老闆抓去埋
先謝謝前輩們的大恩大德

作者: jcchiang 時間: 2020-5-14 10:38

回復 1# 52ee24
不是很懂你的問題,只了解星期日不排程,每日總量不超過一定數量
試試看
Sub 排程()
Application.DisplayAlerts = False
Sheets("WIP").Select
r1 = Sheets("WIP").Range("a1").CurrentRegion.Rows.Count
For i = 5 To 2197 Step 8
Sheets("排程").Range(Sheets("排程").Cells(3, i), Sheets("排程").Cells(2200, i)).Resize(, 3).ClearContents  '清除"批號" & "數量"
Next i

'這段沒資料可使用,先Disable,請自行Enable
'料號
'Sheets("WIP").Range("aj2").Formula = "=LEFT(G2,12)"
'工單代號
'Sheets("WIP").Range("ak2").Formula = "=LEFT(A2,2)"
'標工
'Sheets("WIP").Range("al2").Formula = "=VLOOKUP(D:D,製程站順序與表準工時!A:C,3,0)"
'日產能
'Sheets("WIP").Range("am2").Formula = "=VLOOKUP(D:D,製程站順序與表準工時!A:D,4,0)"
'需要天數
'Sheets("WIP").Range("an2").Formula = "=K2/AL2"
'停滯時數
'Sheets("WIP").Range("ao2").Formula = "=NOW()-W2"
'雷射結束時間
'Sheets("WIP").Range("ap2").Formula = "=VLOOKUP(A:A,工作站產出批號明細!B:R,17,0)"
'計畫完工日
'Sheets("WIP").Range("aq2").Formula = "=IFERROR(IF(AP2+CE2<AT2,AT2,AP2+CE2),"""")"
'離完工天數
'Sheets("WIP").Range("ar2").Formula = "=IFERROR(AQ2-TODAY(),"""")"
'製程剩餘天數
'Sheets("WIP").Range("as2").Formula = "=IFERROR(VLOOKUP(D:D,製程站順序與表準工時!A:E,5,0),"""")"
'建議交貨日
'Sheets("WIP").Range("at2").Formula = "=IF(AS2="""","""",TODAY()+AS2)"
'預計完工
'Sheets("WIP").Range("au2").Formula = "=IFERROR(IF(AQ2<>"""",AQ2-3,AT2),"""")"
'課別
'Sheets("WIP").Range("av2").Formula = "=VLOOKUP(D:D,RunCard!E:G,3,0)"
'製別
'Sheets("WIP").Range("aw2").Formula = "=VLOOKUP(D:D,RunCard!E:H,4,0)"
'製造別
'Sheets("WIP").Range("ax2").Formula = "=VLOOKUP(D:D,RunCard!E:K,7,0)"
'先一次
'Sheets("WIP").Range("aj2:ax2").AutoFill (Sheets("WIP").Range("aj2:ax" & r1))
'Sheets("WIP").Range("aj2:ax" & r1) = Sheets("WIP").Range("aj2:ax" & r1).Value

'第二段啦
'製成需要天數
'Sheets("WIP").Range("ay2").Formula = "=SUMIFS(RunCard!$I:$I,RunCard!$A:$A,WIP!$G2,RunCard!$K:$K,WIP!AY$1)"
'Sheets("WIP").Range("ay2").AutoFill (Sheets("WIP").Range("ay2:ay" & r1))
'Sheets("WIP").Range("ay2:ay" & r1).AutoFill (Sheets("WIP").Range("ay2:cd" & r1))
'Sheets("WIP").Range("ay2:cd" & r1) = Sheets("WIP").Range("ay2:cd" & r1).Value
'總天數
'Sheets("WIP").Range("ce2").Formula = "=SUM(AY2:cd2)"
'Sheets("WIP").Range("ce2").AutoFill (Sheets("WIP").Range("ce2:ce" & r1))

'第三段啦
'計算日期
'Sheets("WIP").Range("cf2").Formula = "=IF($AU2=0,"""",$AU2-SUM(AY2:$cd2))"
'Sheets("WIP").Range("cf2").AutoFill (Sheets("WIP").Range("cf2:cf" & r1))
'Sheets("WIP").Range("cf2:cf" & r1).AutoFill (Sheets("WIP").Range("cf2:dk" & r1))
'Sheets("WIP").Range("cf2:dk" & r1) = Sheets("WIP").Range("cf2:dk" & r1).Value

'第四段啦
'計算工作日
'Sheets("WIP").Range("cn2").Formula = "=IFERROR(ABS($AU2-BT2-NETWORKDAYS.INTL(BT2,$AU2,11)),"""")"
'Sheets("WIP").Range("cn2").AutoFill (Sheets("WIP").Range("cn2:cn" & r1))
'Sheets("WIP").Range("cn2:cn" & r1).AutoFill (Sheets("WIP").Range("cn2:dg" & r1))
'Sheets("WIP").Range("cn2:dg" & r1) = Sheets("WIP").Range("cn2:dg" & r1).Value

'第五段啦
'日期+工作日
'Sheets("WIP").Range("dl2").Formula = "=IF($AU2="""","""",IF((TEXT(cf2,""ddd"")=""Sun""),VALUE(TEXT(cf2+1,""yyyy/mm/dd"")),VALUE(TEXT(cf2,""yyyy/mm/dd""))))"
'Sheets("WIP").Range("dl2").AutoFill (Sheets("WIP").Range("dl2:dl" & r1))
'Sheets("WIP").Range("dl2:dl" & r1).AutoFill (Sheets("WIP").Range("dl2:eq" & r1))
'Sheets("WIP").Range("dl2:eq" & r1) = Sheets("WIP").Range("dl2:eq" & r1).Value

'預計完工(轉換)
'Sheets("WIP").Range("er2").Formula = "=IFERROR(VALUE(TEXT(AU2,""yyyy/mm/dd"")),"""")"
'Sheets("WIP").Range("er2").AutoFill (Sheets("WIP").Range("er2:er" & r1))
'Sheets("WIP").Range("er2:er" & r1) = Sheets("WIP").Range("er2:er" & r1).Value

'排程
Sheets("排程").Select

'01雷射清洗前
For j = 2 To r1
dl = Sheets("WIP").Range("dl" & j)
If dl <> "" Then
   lot = Sheets("WIP").Range("a" & j)
   Wip = Sheets("WIP").Range("k" & j) '增加數量以便統計
'找製程別
   Dim c As Range
   Set c = Sheets("排程").Range("b:b")
   Fnd = c.Find(what:="01雷射清洗前", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Row

'找日期欄
   Dim c1 As Range
   Set c1 = Sheets("排程").Range("a1:cfm1")
   fnd1 = c1.Find(what:=dl, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Column
'找日期列
   Dim c2 As Range
   Set c2 = Sheets("排程").Columns(fnd1)
   fnd2 = c2.Find(what:="", after:=Cells(1, fnd1), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Row
   plus = Cells(Fnd, fnd1 - 2)
   If plus < 2000 Then '總量<2000排入行程
      Cells(fnd2, fnd1) = lot
      Cells(fnd2, fnd1).Offset(, 2) = Wip 'lot的數量
   Else
      For x = 6 To (Cells(2, fnd1).End(2).Column - fnd1) Step 8 '判斷其他日期的總量
         If Cells(Fnd, fnd1).Offset(, x) < 2000 And Cells(Fnd, fnd1).Offset(-2, (x + 3)) <> "日" Then  '排除"日",判斷其他工作日的總量<2000
            Dim c3 As Range
            Set c3 = Sheets("排程").Columns(fnd1 + (x + 2))
            fnd3 = c3.Find(what:="", after:=Cells(1, fnd1 + (x + 2)), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Row
            Cells(fnd3, fnd1).Offset(, (x + 2)) = lot
            Cells(fnd3, fnd1).Offset(, (x + 4)) = Wip
            Exit For
         End If
      Next
   End If
End If
Next j
End Sub

作者: 52ee24 時間: 2020-5-14 10:44

回復 2# jcchiang

不好意思
檔案太大了
全部sheet放不上去
我只能先針對
整理排程帶入排程Sheet裡

作者: 52ee24 時間: 2020-5-14 10:47

回復 2# jcchiang

排程的原則是
1.星期日不能排，要順延
2.每天的總排程量小於2200

作者: jcchiang 時間: 2020-5-14 12:15

回復 4# 52ee24

1.星期日不能排，要順延
If Cells(Fnd, fnd1).Offset(, x) < 2000 And Cells(Fnd, fnd1).Offset(-2, (x + 3)) <> "日" Then '排除"日",判斷其他工作日的總量<2000
a.總量的值請自行調整
b.單日總量大於限制,往後找總量未超過限制的日期排入,遇星期日直接順延
2.每天的總排程量小於2200
If plus < 2000 Then '總量<2000排入行程
a.總量的值請自行調整

作者: 52ee24 時間: 2020-5-14 23:48

回復 5# jcchiang

謝謝 jcchiang
可以跑了!!
另外請問我要複製程式
向下尋找別的製程
但一直貼錯
找不到下個製程的列數
我把變數都增加"02"
這樣哪裡錯了
麻煩幫忙
謝謝你
'02雷射篩孔後
For i = 2 To r1
dm = Sheets("WIP").Range("dm" & i)
If dm <> "" Then
   lot02 = Sheets("WIP").Range("a" & i)
   Wip02 = Sheets("WIP").Range("k" & i)    Dim c02 As Range
   Set c02 = Sheets("??{").Range("b:b")
   Fnd02 = c02.Find(what:="02雷射篩孔後", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Row


   Dim c102 As Range
   Set c102 = Sheets("??{").Range("a1:cfm1")
   fnd102 = c102.Find(what:=dm, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Column

   Dim c202 As Range
   Set c202 = Sheets("排程").Columns(fnd102)
   fnd202 = c202.Find(what:="", after:=Cells(1, fnd102), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Row
   plus02 = Cells(Fnd02, fnd102 - 2)
   If plus02 < 2000 Then
      Cells(fnd202, fnd102) = lot02
      Cells(fnd202, fnd102).Offset(, 2) = Wip02
   Else
      For x = 6 To (Cells(2, fnd102).End(2).Column - fnd102) Step 8
         If Cells(Fnd02, fnd102).Offset(, x) < 2000 And Cells(Fnd02, fnd102).Offset(-2, (x + 3)) <> "日" Then
            Dim c302 As Range
            Set c302 = Sheets("排程").Columns(fnd102 + (x + 2))
            fnd302 = c302.Find(what:="", after:=Cells(1, fnd102 + (x + 2)), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, matchbyte:=False, searchformat:=False).Row
            Cells(fnd302, fnd102).Offset(, (x + 2)) = lot02
            Cells(fnd302, fnd102).Offset(, (x + 4)) = Wip02
            Exit For
         End If
      Next
   End If
End If
Next i

作者: 52ee24 時間: 2020-5-15 21:19

回復 2# jcchiang

謝謝 jcchiang
問題已經解決了
謝謝你的幫忙!!!!

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)