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

標題: [發問] 公式簡化或者使用巨集 [打印本頁]

作者: adam2010 時間: 2023-9-29 02:01 標題: 公式簡化或者使用巨集

請教各位先進是否有更簡化的公式可以取得資料
[attach]36852[/attach]
WIP的D欄位公式源自於說明工作表的良率
[attach]36850[/attach]
根據 C-E (剩餘工作站點)給予不同的良率，數量=原始數量*良率(四捨五入取整數)
判斷良率的順序
1.若A欄位=特殊料號料號(AAA001~7)→Vlookup說明工作表的 T~Z (取第5~11欄)
2.如果產品編號第7碼=W→Vlookup說明工作表的 AA欄 (取第12欄)
3.如果批號第1碼=8→Vlookup說明工作表的 R欄 (取第3欄)
4.剩餘→Vlookup說明工作表的 Q欄 (取第2欄)
由於特殊料號可能還會再增加，所以想詢問是否有更精簡且有彈性的公式可以取代，或者是需要使用巨集
[attach]36851[/attach]

作者: Andy2483 時間: 2023-10-2 09:59

回復 1# adam2010

謝謝前輩發表此主題與範例
後學藉此帖練習陣列與字典,學習方案如下,請前輩參考
[attach]36856[/attach]

執行結果:
[attach]36857[/attach]

Option Explicit
Function F20231002_1(ByVal Va$)
Application.Volatile
Evaluate "TEST()"
F20231002_1 = Va
End Function
Sub TEST()
Dim Brr, Crr, Z, i&, j%, V%, V7%
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range(Sheets("說明").Cells(ActiveSheet.UsedRange.Rows.Count, "A"), [說明!IV1].End(xlToLeft))
For j = 1 To UBound(Brr, 2)
If Trim(Brr(1, j)) <> "" Then Z("/" & Trim(Brr(1, j)) & "/") = j
Next
Crr = Range([WIP!O1], [WIP!A65536].End(3))
For i = 2 To UBound(Crr)
V = Val(Crr(i, 15)): V7 = Val(Crr(i, 7)): Crr(i - 1, 1) = ""
If Z.Exists("/" & Crr(i, 1) & "/") <> Empty Then
   Crr(i - 1, 1) = Round(Brr(V7 + 2, Z("/" & Crr(i, 1) & "/")) * V, 0)
   ElseIf Right(Left(Crr(i, 1), 7), 1) = "W" Then
      Crr(i - 1, 1) = Round(Brr(V7 + 2, Z("/W/")) * V, 0)
   Else
      Crr(i - 1, 1) = Round(Brr(V7 + 2, Z("/" & Split(Crr(i, 2), "X")(0) & """/")) * V, 0)
End If
Next
[WIP!D2].Resize(UBound(Crr) - 1, 1) = Crr
Set Z = Nothing: Erase Brr, Crr
End Sub

作者: Andy2483 時間: 2023-10-2 10:34

回復 2# Andy2483
回復 1# adam2010

修正自己的粗心大意,請以如下範例測試
[attach]36858[/attach]

Function F20231002_1(ByVal Va$)
Application.Volatile
Evaluate "TEST()"
F20231002_1 = Va
End Function

Sub TEST()
Dim Brr, Crr, Z, i&, j%, V%, V7%
Set Z = CreateObject("Scripting.Dictionary")
With Sheets("說明"): Brr = Range(.Cells(.UsedRange.Rows.Count, "A"), .[IV1].End(xlToLeft)): End With
For j = 1 To UBound(Brr, 2)
If Trim(Brr(1, j)) <> "" Then Z("/" & Trim(Brr(1, j)) & "/") = j
Next
Crr = Range([WIP!O1], [WIP!A65536].End(3))
For i = 2 To UBound(Crr)
V = Val(Crr(i, 15)): V7 = Val(Crr(i, 7)): Crr(i - 1, 1) = ""
If Z.Exists("/" & Crr(i, 1) & "/") <> Empty Then
   Crr(i - 1, 1) = Round(Brr(V7 + 2, Z("/" & Crr(i, 1) & "/")) * V, 0)
   ElseIf Right(Left(Crr(i, 1), 7), 1) = "W" Then
      Crr(i - 1, 1) = Round(Brr(V7 + 2, Z("/W/")) * V, 0)
   Else
      Crr(i - 1, 1) = Round(Brr(V7 + 2, Z("/" & Split(Crr(i, 2), "X")(0) & """/")) * V, 0)
End If
Next
[WIP!D2].Resize(UBound(Crr) - 1, 1) = Crr
Set Z = Nothing: Erase Brr, Crr
End Sub

作者: adam2010 時間: 2023-10-2 22:31

回復 3# Andy2483
感謝Andy大出手相助，真是太神速了且可動態更新，不過測試後在判斷順序上有點小問題，
[attach]36866[/attach]
嘗試將剩餘21站的良率作一個區別來驗證(順便增加料號)
[attach]36864[/attach]
發現判斷順序有點問題，正確是1.特殊料號 → 2.料號第7碼=W → 3.批次第1碼=8 其餘才是取Q欄
[attach]36865[/attach]

作者: Andy2483 時間: 2023-10-3 08:34

回復 4# adam2010

謝謝前輩回復
以下是判斷順序 1.特殊料號前6碼 → 2.料號第7碼=W → 3.批次碼(6 找 6"欄 ,8 找 8"欄 ,12 找 12"欄 )

Option Explicit
Function F20231002_1(ByVal Va$)
Application.Volatile
Evaluate "TEST()"
F20231002_1 = Va
End Function

Sub TEST()
Dim Brr, Crr, Z, i&, j%, V%, V7%
Set Z = CreateObject("Scripting.Dictionary")
With Sheets("說明"): Brr = Range(.Cells(.UsedRange.Rows.Count, "A"), .[IV1].End(xlToLeft)): End With
For j = 1 To UBound(Brr, 2)
If Left(Trim(Brr(1, j)), 6) <> "" Then Z(Left(Trim(Brr(1, j)), 6)) = j
Next
Crr = Range([WIP!O1], [WIP!A65536].End(3))
For i = 2 To UBound(Crr)
V = Val(Crr(i, 15)): V7 = Val(Crr(i, 7)): Crr(i - 1, 1) = ""
If Z.Exists(Left(Trim(Crr(i, 1)), 6)) <> Empty Then
   Crr(i - 1, 1) = Round(Brr(V7 + 2, Z(Left(Trim(Crr(i, 1)), 6))) * V, 0)
   ElseIf Right(Left(Crr(i, 1), 7), 1) = "W" Then
      Crr(i - 1, 1) = Round(Brr(V7 + 2, Z("W")) * V, 0)
   Else
      Crr(i - 1, 1) = Round(Brr(V7 + 2, Z(Trim(Split(Crr(i, 2), "X")(0) & """"))) * V, 0)
End If
Next
[WIP!D2].Resize(UBound(Crr) - 1, 1) = Crr
Set Z = Nothing: Erase Brr, Crr
End Sub

作者: adam2010 時間: 2023-10-3 18:58

回復 5# Andy2483

感謝Andy大迅速回覆，經測試完全符合需求，太感謝了
因為也有在程式區詢問此問題，是否可將Andy大的解法分享過去給其他人參考

作者: adam2010 時間: 2023-10-4 19:54

本帖最後由 adam2010 於 2023-10-4 19:56 編輯

回復 5# Andy2483
Sorry~Andy大，應該是我製作的Sample資料檔案不夠完整，在套用時計資料時出現問題
[attach]36869[/attach]

問題在於 3.批次碼(6 找 6"欄 ,8 找 8"欄 ,12 找 12"欄 )，Andy大是取第2碼 X 前的數字當吋別去找對應的良率，
但實際資料12寸是用C代表且批次第2碼不一定是 X
[attach]36870[/attach]

不知到最後一個判斷式該如何修改
Crr(i - 1, 1) = Round(Brr(V7 + 2, Z(Trim(Split(Crr(i, 2), "X")(0) & """"))) * V, 0)
[attach]36872[/attach]

作者: adam2010 時間: 2023-10-4 22:20

回復 7# adam2010

將說明標題改為
[attach]36875[/attach]
然後將最後一個判斷式改為取第1碼後測試成功了，不過還是很感謝Andy大之前的協助，終於完成
  Else
         Crr(i - 1, 1) = Round(Brr(V7 + 2, Z(Left(Crr(i, 2), 1))) * V, 0)

End If

作者: Andy2483 時間: 2023-10-26 13:44

回復 5# Andy2483

謝謝論壇,謝謝各位前輩,以下是複習的心得註解

Sub TEST()
Dim Brr, Crr, Z, i&, j%, V%, V7%
'↑宣告變數:(Brr,Crr,Z)是通用型變數,i是長整數,(j,V,V7)是短整數
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z這通用型變數是字典
With Sheets("說明"): Brr = Range(.Cells(.UsedRange.Rows.Count, "A"), .[IV1].End(xlToLeft)): End With
'↑關於 "說明"工作表的程序:
'令Brr這通用型變數是二維陣列,以第1列最左邊有內容儲存格到 A欄已使用列(最大列號)儲存格,
'以這範圍儲存格值帶入Brr陣列中
For j = 1 To UBound(Brr, 2)
'↑設順迴圈!令j變數從1 到Brr陣列最大索引欄號
If Left(Trim(Brr(1, j)), 6) <> "" Then Z(Left(Trim(Brr(1, j)), 6)) = j
'↑如果第1列j迴圈欄Brr陣列值去除頭尾空白字元後取左側6字元的新字串不是空字元!
'就令以第1列j迴圈欄Brr陣列值去除頭尾空白字元後取左側6字元的新字串當key,
'j變數當item納入Z字典中
Next
Crr = Range([WIP!O1], [WIP!A65536].End(3))
'↑令Crr這通用型變數是二維陣列,以[O1]儲存格到 A欄最後有內容儲存格,
'以這範圍儲存格值帶入Crr陣列中
For i = 2 To UBound(Crr)
'↑設順迴圈!令i變數從2 到Brr陣列最大索引列號
V = Val(Crr(i, 15)): V7 = Val(Crr(i, 7)): Crr(i - 1, 1) = ""
'↑令V這短整數變數是 i迴圈列15欄Crr陣列值轉化的數值
'↑令V7這短整數變數是 i迴圈列7欄Crr陣列值轉化的數值
'↑令(i-1)迴圈列1欄Crr陣列值是空字元
If Z.Exists(Left(Trim(Crr(i, 1)), 6)) <> Empty Then
'↑如果以第1列j迴圈欄Crr陣列值去除頭尾空白字元後取左側6字元的新字串(以下稱產品編號),
'若以產品編號查到Z字典有此key!
   Crr(i - 1, 1) = Round(Brr(V7 + 2, Z(Left(Trim(Crr(i, 1)), 6))) * V, 0)
   '↑令(i-1)列1欄Crr陣列值是 (V7變數+2列,產品編號查字典回傳item值欄)Brr陣列值,
   '再乘以V變數後,該值小數1位四捨五入到整數
   ElseIf Right(Left(Trim(Crr(i, 1)), 7), 1) = "W" Then
   '↑否則如果以第1列j迴圈欄Crr陣列值去除頭尾空白字元後取第7字元是"W"!
      Crr(i - 1, 1) = Round(Brr(V7 + 2, Z("W")) * V, 0)
      '↑令(i-1)列1欄Crr陣列值是 (V7變數+2列,"W"查字典回傳item值欄)Brr陣列值,
      '再乘以V變數後,該值小數1位四捨五入到整數
   Else
      Crr(i - 1, 1) = Round(Brr(V7 + 2, Z(Trim(Split(Crr(i, 2), "X")(0) & """"))) * V, 0)
      '↑令(i-1)列1欄Crr陣列值是 (V7變數+2列,批號第1規格碼查字典回傳item值欄)Brr陣列值,
      '再乘以V變數後,該值小數1位四捨五入到整數
      '註批號第1規格碼: i迴圈列第2欄Crr陣列值,以"X"分割成的一維陣列的第0索引號陣列值連接 "符號
End If
Next
[WIP!D2].Resize(UBound(Crr) - 1, 1) = Crr
'↑令"WIP"工作表[D2]向下擴展Crr縱向最大索引列號-1列,此範圍儲存格值以Crr陣列值帶入
Set Z = Nothing: Erase Brr, Crr
'↑令釋放變數
End Sub

作者: 准提部林 時間: 2023-10-28 12:52

按原公式改下//
=ROUND(VLOOKUP(G2,說明!$P:$AC,LOOKUP(99,CHOOSE({1,2,3,4},2,3/(LEFT(B2)="8"),12/(MID(A2,7,1)="W"),MATCH(A2,說明!$T$1:$Z$1,)+4)),)*O2,)

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