返回列表 上一主題 發帖

每日總量限制

每日總量限制

各位前輩好
我的需求是要把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
   

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

排程計畫-0511.rar (958.42 KB)

排程計畫-0511.rar (956.21 KB)

排程計畫-0511.rar (956.21 KB)

回復 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

TOP

回復 2# jcchiang


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

TOP

回復 2# jcchiang


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

TOP

回復 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.總量的值請自行調整

TOP

回復 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

TOP

回復 2# jcchiang


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

TOP

        靜思自在 : 不要隨心所欲,要隨心教育自己。
返回列表 上一主題