A至F 是資料來源, H至N 欄是我做例子說明的資料, 平時不會存在在Excel 內, 只有A欄至F欄資料而已, 同時資料有時有多有少,A欄 為空白。

[attach]32995[/attach]

[attach]32996[/attach]

[attach]32997[/attach]

Sub TEST_A01()
Dim Arr, Brr, i&, j%, k%, X%, V1&, V2&, N&
Arr = Sheets("Sheet1").UsedRange
ReDim Brr(1 To 20000, 1 To 6)
For X = 1 To 6: Brr(1, X) = Arr(1, X): Next
For i = 2 To UBound(Arr)
V1 = Int((Arr(i, 4) - 1) / Arr(i, 9))
V2 = Arr(i, 4) - V1 * Arr(i, 9)
For j = 12 To UBound(Arr, 2)
If Arr(i, j) = "" Then GoTo j01
For k = 1 To V1 + 1
N = N + 1
For X = 2 To 6: Brr(N + 1, X) = Arr(i, X): Next
Brr(N + 1, 1) = Arr(i, j)
Brr(N + 1, 4) = IIf(k > V1, V2, Arr(i, 9))
Next k
j01: Next j
Next i
.[A1].Resize(N + 1, 6) = Brr
.Name = Format(Now, "yyyymmdd-hhmmss")
End With
End Sub

[attach]32998[/attach]

========================

1. Public Sub 資料分拆練習()
2. Application.ScreenUpdating = False
3. Arr = [A1].CurrentRegion
4. Ar = [{900, "1,2", "3,4", "5"; 900, "1,2", "3,4","-"; 1800, "Support","-","-"}]

5. Sheets.Add(After:=Sheets(1)).Name = "結果" & Format(Now, "-YYYY-MM-DD")
6. For Y = 1 To UBound(Arr, 2): Cells(1, Y) = Arr(1, Y): Next Y
7. For X = 1 To UBound(Ar)
8.     A = Int(Arr(2 + k, 4) / Ar(X, 1)) + 1
9.     C = Arr(2 + k, 4) - (A - 1) * Ar(X, 1)
10.     For i = 2 To UBound(Ar, 2)
11.         If Ar(X, i) <> "-" Then
12.         For Y = 1 To A
13.             If u < A Then u = u + 1
14.             E = IIf(u = A, C, Ar(X, 1))
15.             Cells(2 + G, 1) = Ar(X, i)
16.             Cells(2 + G, 2) = Arr(2 + k, 2)
17.             Cells(2 + G, 3) = Arr(2 + k, 3)
18.             Cells(2 + G, 4) = E
19.             Cells(2 + G, 5) = Arr(2 + k, 5)
20.             Cells(2 + G, 6) = Arr(2 + k, 6)
21.             G = G + 1
22.         Next Y
23.         End If
24.     u = 0
25.     Next i
26. k = k + 1
27. Next X
28. Application.ScreenUpdating = True
29. End Sub

Sub TEST_A01()
Dim Arr, Brr, i&, j%, k%, X%, V1&, V2&, N&
Arr = Sheets("Sheet1").UsedRange
ReDim  ...

謝謝准大幫忙,經測試是完全OK的。

[attach]33007[/attach]

謝謝大大細心幫忙,非常感謝, 經測試都是ok的,不過我需要再更新內容,所以就不好意思再麻煩你了。謝謝

item 只有這三種???

[attach]33008[/attach]

item 只有這三種???

是的,只有三個ITEM, 再次感謝准大,。

完全符合要求內容,不好意思一直麻煩你。

 歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)