- 帖子
- 234
- 主題
- 19
- 精華
- 0
- 積分
- 276
- 點名
- 0
- 作業系統
- Windows XP
- 軟體版本
- office 2003
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2013-1-7
- 最後登錄
- 2021-10-7
|
2#
發表於 2021-3-12 12:48
| 只看該作者
回復 1# stephenlee
試試看,寫不好,再看有沒有高手出手
另外050不是2000分拆嗎??,為何你的範例第一組2000分拆,第二組又變成2100分拆(第二組值剛好為2100,所以範例沒分拆)
Sub ex()
Dim X%, Y%, K%, Z%, Count%, Check$, a As Object, d As Object
Set d = CreateObject("Scripting.Dictionary")
Sheets("附表1").UsedRange.ClearContents
Sheets("附表1").[a1:L1] = Array("Line", "RP", "CP", "job 1", "job 2", "job 3", "item", " ", "f", "t", "QTY", "group")
For Each a In Sheets("要處理的資料").Range([L2], [L2].End(4))
d(a.Value) = a.Offset(, 1)
Next
For Each a In Sheets("要處理的資料").Range([D2], [D65535].End(3))
If Check = "" Then
Check = a.Value
ElseIf Check <> a.Value Then
Z = 4 - (Count Mod 4)
Count = 0
Check = a.Value
End If
If d.exists(a.Value) Then
With Sheets("附表1")
K = 1: X = 0
If a.Offset(, 1) > d(a.Value) Then
For Y = 1 To WorksheetFunction.Quotient(a.Offset(, 1), d(a.Value))
a.Offset(, -3).Resize(, 3).Copy .[a65535].End(3).Offset(1 + Z).Resize(, 3)
.[g65535].End(3).Offset(1 + Z).Resize(, 6) = Array(a, a.Offset(, 1), K, X + d(a.Value), d(a.Value), a.Offset(, 5))
K = .[I65535].End(3) + d(a.Value)
X = .[J65535].End(3)
Z = 0
Next
a.Offset(, -3).Resize(, 3).Copy .[a65535].End(3).Offset(1 + Z).Resize(, 3)
.[g65535].End(3).Offset(1 + Z).Resize(, 6) = Array(a, a.Offset(, 1), d(a.Value) + .[I65535].End(3), a.Offset(, 1), a.Offset(, 1) Mod d(a.Value), a.Offset(, 5))
Count = Y + Count
Else
a.Offset(, -3).Resize(, 3).Copy .[a65535].End(3).Offset(1 + Z).Resize(, 3)
.[g65535].End(3).Offset(1 + Z).Resize(, 6) = Array(a, a.Offset(, 1), 1, a.Offset(, 1), a.Offset(, 1), a.Offset(, 5))
Count = Count + 1
Z = 0
End If
End With
End If
Next
Set d = Nothing
End Sub |
|
發表於 2021-3-13 10:34
| 