- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2024-12-18
|
18#
發表於 2021-12-13 07:17
| 只看該作者
回復 16# cypd
依閣下指導公式修改之後執行產生錯誤如下
>> 請再測試看看，謝謝
Sub test()
Dim Arr, xD, Brr, T, T1, TT$, ck%, ck1%, i&
Set xD = CreateObject("Scripting.Dictionary")
With Range("b2:d" & [B65536].End(3).Row - 2)
Brr = .Value
.Sort Key1:=.Item(1), Order1:=1, Header:=1
Arr = .Value
For i = 2 To UBound(Arr)
TT = Arr(i, 1) & "|" & Arr(i, 2)
If Arr(i, 1) = 100 Then
If ck = 0 Then
T = 64565
Arr(i, 3) = "A00" & T & "-" & Format(T + Arr(i, 2) - 1, "A0000000")
ck = 1: T1 = T + Arr(i, 2): xD(TT) = Arr(i, 3)
Else
Arr(i, 3) = "A00" & T1 & "-" & Format(T1 + Arr(i, 2) - 1, "A0000000")
T1 = T1 + Arr(i, 2): xD(TT) = Arr(i, 3)
End If
Else
If ck1 = 0 Then
T = 81141
Arr(i, 3) = "B00" & T & "-" & Format(T + Arr(i, 2) - 1, "B0000000")
ck1 = 1: T1 = T + Arr(i, 2): xD(TT) = Arr(i, 3)
Else
Arr(i, 3) = "B00" & T1 & "-" & Format(T1 + Arr(i, 2) - 1, "B0000000")
T1 = T1 + Arr(i, 2): xD(TT) = Arr(i, 3)
End If
End If
Next
For i = 2 To UBound(Brr): TT = Brr(i, 1) & "|" & Brr(i, 2): Brr(i, 3) = xD(TT): Next
.Value = Brr
End With
End Sub
|
|
發表於 2021-12-11 19:17
| 
