12
返回列表 上一主題 發帖

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

adam2010

帖子
145 
主題
42 
精華
0 
積分
193 
點名
0  
作業系統
Windows7 
軟體版本
Office2010 
閱讀權限
20 
性別
男 
註冊時間
2010-11-25 
最後登錄
2023-11-17 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2023-9-29 02:01 | 只看該作者

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

請教各位先進是否有更簡化的公式可以取得資料
公式簡化 20230929.rar (107.82 KB)
WIP的D欄位公式源自於說明工作表的良率
說明工作表.jpg
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欄)
由於特殊料號可能還會再增加，所以想詢問是否有更精簡且有彈性的公式可以取代，或者是需要使用巨集
WIP.jpg
2023-9-29 01:55
收藏 分享
Adam

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1077 
主題
40 
精華
0 
積分
1102 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010&2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2023-11-28 
2#
發表於 2023-10-2 09:59 | 只看該作者
回復 1# adam2010


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

執行結果:
20231002-1.jpg
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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1077 
主題
40 
精華
0 
積分
1102 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010&2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2023-11-28 
3#
發表於 2023-10-2 10:34 | 只看該作者
回復 2# Andy2483
回復 1# adam2010


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



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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

adam2010

帖子
145 
主題
42 
精華
0 
積分
193 
點名
0  
作業系統
Windows7 
軟體版本
Office2010 
閱讀權限
20 
性別
男 
註冊時間
2010-11-25 
最後登錄
2023-11-17 

論壇贊助勳章
4#
發表於 2023-10-2 22:31 | 只看該作者
回復 3# Andy2483
感謝Andy大出手相助，真是太神速了且可動態更新，不過測試後在判斷順序上有點小問題，
公式簡化 20231002-3.rar (115.09 KB)
嘗試將剩餘21站的良率作一個區別來驗證(順便增加料號)
測試增加料號-21.jpg
2023-10-2 22:27

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

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1077 
主題
40 
精華
0 
積分
1102 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010&2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2023-11-28 
5#
發表於 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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

adam2010

帖子
145 
主題
42 
精華
0 
積分
193 
點名
0  
作業系統
Windows7 
軟體版本
Office2010 
閱讀權限
20 
性別
男 
註冊時間
2010-11-25 
最後登錄
2023-11-17 

論壇贊助勳章
6#
發表於 2023-10-3 18:58 | 只看該作者
回復 5# Andy2483

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

TOP

adam2010

帖子
145 
主題
42 
精華
0 
積分
193 
點名
0  
作業系統
Windows7 
軟體版本
Office2010 
閱讀權限
20 
性別
男 
註冊時間
2010-11-25 
最後登錄
2023-11-17 

論壇贊助勳章
7#
發表於 2023-10-4 19:54 | 只看該作者
本帖最後由 adam2010 於 2023-10-4 19:56 編輯

回復 5# Andy2483
Sorry~Andy大，應該是我製作的Sample資料檔案不夠完整，在套用時計資料時出現問題
偵錯1004.jpg
2023-10-4 19:42


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

公式簡化 20231002-3.rar (114.76 KB)

Adam

TOP

        靜思自在 : 口說好話、心想好意、身行好事。
12
返回列表 上一主題