軒云熊

回復 1# stephenlee
參考了 準大的寫法  順便練習 有空的話也順便幫我看看 是否正常 感謝

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

複製代碼

軒云熊

回復 5# stephenlee

不 是我在麻煩你  是我借你的題目來學習 浪費了你寶貴的時間 我感到抱歉 謝謝你幫我測試 感恩