[發問] VBA計算箱子號碼

本帖最後由 john2006168 於 2021-4-22 11:59 編輯

請問有沒有老師可以幫忙寫一下,學習一下不同的思路?
想要黃色的結果
revised plt4
PLT NO. 4 40 C1-C40 C

擷取.PNG (7.19 KB)

TEST VBA1.zip (11.02 KB)

樓主熱帖

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

2^#

發表於 2021-4-22 13:12 | 只看該作者

回復 1# john2006168

不好意思，看不太懂解規則是什麼，可否請再細說明一下，謝謝

TOP

john2006168

　暱稱: jjjohn

中學生 Rank: 2

帖子: 178
主題: 65
精華: 0
積分: 252
點名: 0
作業系統: WINDOW7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2010-5-4
最後登錄: 2024-2-1

3^#

發表於 2021-4-22 13:59 | 只看該作者

回復 2# samwang
考慮條件E欄是順序P和C的,如果是P板,第一板是10件,編紙箱號碼就用P1-P10,第二板20件,就用P11-P30,以此類推.,如果是C板,第一板是10件,編紙箱號碼就用C1-C10,第二板20件,就用C11-C30,以此類推.

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

4^#

發表於 2021-4-22 15:20 | 只看該作者

回復 3# john2006168

請測試看看，謝謝。

Sub test()
Dim Arr, xD, TT, T, T1, T2, T3, N%, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = [A1].CurrentRegion
For i = 2 To UBound(Arr)
T = Arr(i, 5): T2 = Arr(i, 2): T3 = Arr(i, 3)
If xD.Exists(T & "") Then
      If N = 0 Then
         N = 1: TT = xD(T & "")(0)
      Else
         TT = xD(T & "")(0) + T1
      End If
      Arr(i, 1) = Arr(i, 5) & TT & "1" & "-" & T & T3 + xD(T & "")(1)
      xD(T & "") = Array(T2, T3 + xD(T & "")(1))
Else
      Arr(i, 1) = Arr(i, 5) & "1" & "-" & T & T3
      xD(T & "") = Array(T2, T3): N = 0: T1 = xD(T & "")(0)
End If
Next
Arr(1, 1) = "Carton"
Range("D1").Resize(UBound(Arr), 1) = Arr
End Sub

TOP

john2006168

　暱稱: jjjohn

中學生 Rank: 2

帖子: 178
主題: 65
精華: 0
積分: 252
點名: 0
作業系統: WINDOW7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2010-5-4
最後登錄: 2024-2-1

5^#

發表於 2021-4-22 15:52 | 只看該作者

回復 4# samwang

謝謝老師.這個可以,感謝抽時間回覆,但是看得不是很懂.如果有注解會更好點.
另外,請問有沒有其他大大,可以提供其他寫法(不用UBound 函數)

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

6^#

發表於 2021-4-22 17:20 | 只看該作者

回復 5# john2006168

我盡力加入註解，可能有些寫得不好不詳細，請您自行研究了，謝謝。

Sub test1()
Dim Arr, xD, TT, T, T1, T2, T3, N%, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = [A1].CurrentRegion '資料放入數組
For i = 2 To UBound(Arr)
'T:E欄資料、T2:B欄、T3:C欄
T = Arr(i, 5): T2 = Arr(i, 2): T3 = Arr(i, 3)
If xD.Exists(T & "") Then '字典有無E欄資料
      If N = 0 Then
         N = 1: TT = xD(T & "")(0) '重複出現的第1次依規則編號(第2碼)
      Else
         TT = xD(T & "")(0) + T1 '重複出現的第2次以上依規則編號(第2碼)
      End If
      Arr(i, 1) = Arr(i, 5) & TT & "1" & "-" & T & T3 + xD(T & "")(1) '依規則編號
      xD(T & "") = Array(T2, T3 + xD(T & "")(1)) 'C欄(kg)累加裝入字典
Else
      Arr(i, 1) = Arr(i, 5) & "1" & "-" & T & T3  '第1次出現，依規則編號放入Arr
      xD(T & "") = Array(T2, T3): N = 0: T1 = xD(T & "")(0) 'B,C欄資料放入字典，T1設為B欄第一次出現數值，N=0歸零(P-C)
End If
Next
Arr(1, 1) = "Carton"
Range("d1").Resize(UBound(Arr), 1) = Arr
End Sub

TOP

john2006168