[發問] 公式簡化或者使用巨集

adam2010

請教各位先進是否有更簡化的公式可以取得資料
公式簡化 20230929.rar (107.82 KB)

下載次數: 3

2023-9-29 01:55

WIP的D欄位公式源自於說明工作表的良率

下載 (103.98 KB)

2023-9-29 01:55

根據 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欄)
由於特殊料號可能還會再增加，所以想詢問是否有更精簡且有彈性的公式可以取代，或者是需要使用巨集

下載 (254.37 KB)

2023-9-29 01:55

Andy2483

回復 1# adam2010


    謝謝前輩發表此主題與範例
後學藉此帖練習陣列與字典,學習方案如下,請前輩參考
公式簡化 20231002.zip (115.5 KB)

下載次數: 1

2023-10-2 09:58

執行結果:

下載 (219.64 KB)

2023-10-2 09:58

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

回復 2# Andy2483
回復 1# adam2010


    修正自己的粗心大意,請以如下範例測試
公式簡化 20231002-1.zip (115.58 KB)

下載次數: 2

2023-10-2 10:33

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

回復 3# Andy2483
感謝Andy大出手相助，真是太神速了且可動態更新，不過測試後在判斷順序上有點小問題，
公式簡化 20231002-3.rar (115.09 KB)

下載次數: 3

2023-10-2 22:27

嘗試將剩餘21站的良率作一個區別來驗證(順便增加料號)

下載 (42.08 KB)

2023-10-2 22:27

發現判斷順序有點問題，正確是1.特殊料號 → 2.料號第7碼=W → 3.批次第1碼=8 其餘才是取Q欄

下載 (145.57 KB)

2023-10-2 22:27

Andy2483

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

回復 5# Andy2483

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

adam2010

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

下載 (58.14 KB)

2023-10-4 19:42

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

下載 (38 KB)

2023-10-4 19:49

不知到最後一個判斷式該如何修改
            Crr(i - 1, 1) = Round(Brr(V7 + 2, Z(Trim(Split(Crr(i, 2), "X")(0) & """"))) * V, 0)
    公式簡化 20231002-4.rar (113.36 KB)

下載次數: 4

2023-10-4 19:52

adam2010

回復 7# adam2010

將說明標題改為

下載 (5.13 KB)

2023-10-4 22:19

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

Andy2483

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

准提部林

按原公式改下//
=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,)