准提部林

異動表排序//B欄公式...可參考
=-LOOKUP(,-MID(C1&"|0",LOOKUP(99,FIND({"|","#","#M","#AL"},C1&"|")+{1,1,2,3}),ROW($1:$9)))
沒有符合的顯示0

A欄公式因版本看不到~~

准提部林

來源檔判斷是否開啟//
On Error Resume Next: Set xB = Workbooks(FN): On Error GoTo 0
If xB Is Nothing Then Set xB = Workbooks.Open(PH & "\" & FN): chk = 1
With xB.Sheets("異動表排序")
     Brr = Range(.[G1], .[A65536].End(3)(2))
End With
If chk = 1 Then xB.Close 0

解析//檔案若是事先手動開啟, 不關閉// 若是由程式開啟, 則由程式關閉
為何:
1) 檔案如已開啟, 程式就不可以再開一次, 會造成當機
2) 檔案是手動開啟的, 可能有更改內容而未存檔, 若直接關閉它, 資料將不會被儲存

cowww

回復 30# qaqa3296

非常感謝qaqa3296大大的解惑

cowww

回復 31# 准提部林

非常感謝准提部林大大的解惑

cowww

回復 31# 准提部林

非常感謝准提部林大大的解惑
A欄位的公式
如果B欄位有以下的內容就在前面加入指定的文字
AL#>>前面加入SML-，"M01""M02""M03">>前面加入SML5#
1~15+18+57+21~47+53+49~95+85+58+121~125+164~169+178~179>>前面加入SML3#
96~120>>前面加入PMP#
19+126~128+134~141+183~189>>前面加入SML5#
142~163+181+182>>前面加入SML6#
173~176+180>>前面加入SML7#

=IF(ISNUMBER(SEARCH("AL#",B1)),"SML-"&B1,IF(OR(B1="M01",B1="M02",B1="M03"),"SML5#"&B1,IF(ISNUMBER(B1),
IF(OR(B1=1,B1=2,B1=3,B1=4,B1=5,B1=6,B1=7,B1=8,B1=9,B1=10,B1=11,B1=12,B1=13,B1=14,B1=15,B1=18,B1=57,(B1>=21)*(B1<=47),B1=53,(B1>=49)*(B1<=95),B1=85,B1=58,(B1>=121)*(B1<=125),(B1>=164)*(B1<=169),(B1>=178)*(B1<=179)),
"SML3#"&TEXT(B1,"000"),
IF(AND(B1>=96,B1<=120),
"PMP#"&TEXT(B1,"000"),
IF(OR(B1=19,(B1>=126)*(B1<=128),(B1>=134)*(B1<=141),(B1>=183)*(B1<=189)),
"SML5#"&TEXT(B1,"000"),
IF(OR((B1>=142)*(B1<=163),B1=181,B1=182),
"SML6#"&TEXT(B1,"000"),
IF(OR((B1>=173)*(B1<=176),B1=180),
"SML7#"&TEXT(B1,"000"),
""
)
)
)
)
),
""
)))

Andy2483

回復 32# 准提部林
回復 30# qaqa3296
回復 27# cowww


    謝謝前輩再提供新範例
謝謝 准提部林前輩指導
謝謝 qaqa3296 一起學習,超認真的學習方案
後學也提供學習方案建議如下,請前輩參考

執行結果:

下載 (319.14 KB)

2023-7-10 10:47

下載 (318.37 KB)

2023-7-10 11:09

Option Explicit
Sub 機台排程_Click()
Application.ScreenUpdating = False
Dim Brr, Z, A$, B$, C%, Nm&, chk, Np, i&, R&, T$, T1$, PH$, FN$, xB As Workbook, Sh As Worksheet
Set Z = CreateObject("Scripting.Dictionary")
PH = ThisWorkbook.Path: FN = "異動表排序.xlsm"
On Error Resume Next: Set xB = Workbooks(FN): On Error GoTo 0
If xB Is Nothing Then Set xB = Workbooks.Open(PH & "\" & FN): chk = 1
With xB.Sheets("異動表排序")
     Brr = Range(.[G1], .[A65536].End(3)(2))
End With
If chk = 1 Then xB.Close 0
For i = 2 To UBound(Brr) - 1
   If IsError(Brr(i, 1)) Or IsError(Brr(i, 2)) Or Brr(i, 4) = "" Then GoTo i00
   '↑1.2欄有錯誤值 或無模具號碼 略過
   T = Brr(i, 4): T1 = Brr(i, 1): A = Z(T1)
   If A = "" Then
      For R = i To UBound(Brr)
         If IsError(Brr(R, 1)) Or IsError(Brr(R, 2)) Or Brr(R, 4) = "" Then GoTo R00
         '↑1.2欄有錯誤值 或無模具號碼 略過
         If T1 <> Brr(R, 1) Then Exit For
         For C = 4 To 7: B = B & " " & Brr(R, C): Next:
         B = Brr(R, 3) & "       " & B
         If i = R Then A = Brr(R, 1) & vbLf & B Else A = A & vbLf & B
         Z(T1) = A: B = ""
R00:  Next
   End If
   If Z(T) = "" Then
      Z(T) = Z(T1)
      ElseIf InStr(Z(T), Z(T1)) = 0 Then
         Z(T) = Z(T) & vbLf & vbLf & Z(T1)
   End If
i00: Next
Brr = Range([專案!Z1], [專案!D65536].End(3))
[Z:Z].ClearComments: [Z:Z].Interior.ColorIndex = xlNone
For i = 1 To UBound(Brr)
   T1 = Brr(i, 1)
   If Z(T1) = "" And Z(Brr(i, 23)) <> "" Then
      Cells(i, 26).Interior.ColorIndex = 38
      Np = Np + 1: GoTo i01
   End If
   If T1 = "" Or Z(T1) = "" Then GoTo i01
   If Cells(i, 26) = "" Then
      Nm = Nm + 1
      Cells(i, 26).Interior.ColorIndex = 6
   End If
   With Cells(i, 26).AddComment
      .Text Text:=Replace(Z(T1), "        " & T1, "_★_" & T1)
      .Shape.TextFrame.Characters.Font.Size = 16
      .Shape.DrawingObject.AutoSize = True
   End With
i01: Next
If Nm + Np > 0 Then
   MsgBox "有排程 無標示機台: " & Nm & " 個" & vbLf & vbLf & _
          "有標示機台 無排程: " & Np & " 個"
End If
Set Z = Nothing: Erase Brr: Set xB = Nothing: Set Sh = Nothing
End Sub

cowww

回復 36# Andy2483

非常感謝Andy2483大大的解惑

Andy2483

回復 35# cowww


    後學猜測前方所加入的應該是機台廠牌/型號
建議改以輔助表列出該廠牌型號的機台明細做對照,設計可自動擴充的新公式,
以免機台增減還需修改現有這方式的A,B欄公式

下載 (67.18 KB)

2023-7-10 13:42

cowww

回復 38# Andy2483

非常感謝Andy2483大大的解惑

這個方法好
雖然增加機台的可能性很低
但是比起超長的公式，機台明細對照表卻是比較方便且比較易懂