返回列表 上一主題 發帖

[發問] 資料分拆問題。

[發問] 資料分拆問題。

本帖最後由 stephenlee 於 2021-1-23 11:34 編輯

請問各位高手,如何用VBA 做以下要求,非常感謝

A至F 是資料來源, H至N 欄是我做例子說明的資料, 平時不會存在在Excel 內, 只有A欄至F欄資料而已, 同時資料有時有多有少,A欄 為空白。
當中B欄和F欄我要對應進行分拆數量,例如如果該行的ITEM 為SC1 , 則 D欄QTY 那要分拆數量為 要求的數量, 例如II欄對應的拆數要求為900
那D2 便要分拆900出來,除了QTY要分拆數量外,其他資料不變.但D2因為多於900, 所以新增行數去分拆數量出來,另外也要對應 分類 K欄的資料, 如果 F欄的分類是3的話
要自動懂用我例子所示,懂分三個組合去合成D欄QTY的數量

例如 F2= 3  個分類  即是 = 3個組合 每個組合要分拆組合成D2 的數量

當分拆數量後,自動在A 欄 "Page" 填上 1,2 , 或者 3,4 , 或者5 或者Support這樣。


資料來源不變, 當我執行VBA 後,他會將運算結果以新增一張工作表顯示結果,例如Sheet2 這樣。

每次當我將資料複製至Sheet1 的A欄至F欄後, 執行VBA 則每次都新增一張工作表顯示結果出來。


執行VBA後以貼上值的方法新增工作表,則不會將資料來源的格式都複製過去,例如字型及字體大小都不要跟過去。



資料來源:


1..JPG
2021-1-23 11:30


執行後的結果:

2..JPG
2021-1-23 11:31



分類要求.zip (9.12 KB)

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
With Sheets.Add
     .[A1].Resize(N + 1, 6) = Brr
     .Name = Format(Now, "yyyymmdd-hhmmss")
End With
End Sub

Xl0000051.rar (14.89 KB)


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

TOP

本帖最後由 軒云熊 於 2021-1-24 18:56 編輯

回復 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. 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
複製代碼

TOP

Sub TEST_A01()
Dim Arr, Brr, i&, j%, k%, X%, V1&, V2&, N&
Arr = Sheets("Sheet1").UsedRange
ReDim  ...
准提部林 發表於 2021-1-23 17:38



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

不過不好意思.我忘了說 H到N那, 的組合不是固定的

例如  SC1 拆數一定是 900  , SC2 拆數一定是900,SC3 拆數 一定是 1800, 但他的組合不是 SC1 鎖定了 分類 第 3 , 而SC2 不是鎖定了是第2, 不過SC3 就必定是1 。

例如 SC1 的分類可以去 2 , 就是 1,2 和 3.4 。 而SC2 的分類可以去 3, 就是 1,2 + 3,4 +5


而SC3 則一直不變。

而SC2和SC3 未必每次都有資料, 所以跟拆數後也要跟分類來新增行數。

而做法都是跟之前要求一樣,填上資料後,根據數量及分類執行再以新一個工作表顯示。 只不過是按照每次所填上的Item 和分類來判斷做整理。

特別不好意思,再麻煩你。 非常感激你的細心幫忙。謝謝


分類要求 更新.zip (10.78 KB)

TOP

回復  stephenlee
參考了 準大的寫法  順便練習 有空的話也順便幫我看看 是否正常 感謝
軒云熊 發表於 2021-1-24 18:54



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

TOP

回復 4# stephenlee


item 只有這三種???
而分類最多是3???

其實事先在H:N輸入要分拆的資料就可以? 沒有的資料它也不會跑出來

TOP

回復 4# stephenlee

參考看看:
Xl0000051-02.rar (16.26 KB)

TOP

回復  stephenlee


item 只有這三種???
而分類最多是3???

其實事先在H:N輸入要分拆的資料就可以?  ...
准提部林 發表於 2021-1-26 14:45



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

TOP

回復  stephenlee

參考看看:
准提部林 發表於 2021-1-26 15:11



    完全符合要求內容,不好意思一直麻煩你。
非常感謝閣下一直幫忙,而且非常快地幫了我解決問題,幫我節省了很多時間。再次感謝。

TOP

回復 5# stephenlee

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

TOP

        靜思自在 : 得理要饒人,理直要氣和。
返回列表 上一主題