麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] Excel 分拆數量。 [打印本頁]

作者: stephenlee 時間: 2021-10-23 16:43 標題: Excel 分拆數量。

Sheet1 是資料來源

F欄及G欄數量一開始是一樣的。

但我要根據 J 欄分類來進行數量分拆

用G欄來分拆數量。

J欄只有兩個固定

1個是 ST 或者 HT  沒有第三個

檔案有機會J欄全是 ST 或者HT, 或者兩者一起存在。

而ST 分拆數量要為 3000 尾數要100內。

例如

5412  要分拆以3000 為基數

所以要再新增一列

G欄則為 3000 一列和2412一列。

F欄是留給我看到底有多少數量。

如果J欄為 ST, 數量為 3100  那就不要新增一列拆數。

但如果是 3101 尾數大於100, 則要拆 3000 一列, 101一列。

如果J欄是HT 也是, HT 要分拆以1000 為基數,也是100內尾數。

1200 拆 1000 及 200

分拆完數量後,則再按照H欄 MO# 來新增空白列。

如果H欄從H2 開始項目個數是2的倍數就不用新增一列。

如果是單數就要新增一列。

我要在Sheet1 新增一個按鈕,待我在Sheet1 有資料後,點擊按鈕可以根據 J欄及G欄做新增欄拆數,最後以H欄要新增空白列。

得出結果,以新增一個工作表得出。

就是我在Sheet1點擊按鈕後得出結果在新一個工作表中。  (演示結果為Sheet2)

麻煩大家。

[attach]34270[/attach]

作者: hcm19522 時間: 2021-10-24 16:50

參考
https://blog.xuite.net/hcm19522/twblog/590088794

作者: 准提部林 時間: 2021-10-24 16:54

Sub TEST_A1()
Dim Arr, Brr, i&, j%, k%, Cn%, V%, V1%, V2%, N&, R&
Sheets("Sheet2").[a:j].ClearContents
Arr = Range(Sheets("Sheet1").[j1], Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp)(2))
ReDim Brr(1 To 30000, 1 To 10)
For i = 2 To UBound(Arr) - 1
V = IIf(Arr(i, 10) = "HT", 1000, 3000) '除數
V1 = Val(Arr(i, 7)) '數量
Cn = Int(V1 / V) + 1 '分拆行數
V2 = V1 Mod V '餘數
If V2 < 101 And Cn > 1 Then Cn = Cn - 1: V2 = V + V2
For j = 1 To Cn
      N = N + 1
      For k = 1 To 10: Brr(N, k) = Arr(i, k): Next
      Brr(N, 7) = IIf(j = Cn, V2, V)
Next j
If Arr(i, 8) <> Arr(i + 1, 8) And N Mod 2 = 1 Then N = N + 1
Next i
Sheets("Sheet2").[a1:j1] = Sheets("Sheet1").[a1:j1].Value
Sheets("Sheet2").[a2].Resize(N, 10) = Brr
End Sub

作者: stephenlee 時間: 2021-10-26 08:02

Sub TEST_A1()
Dim Arr, Brr, i&, j%, k%, Cn%, V%, V1%, V2%, N&, R&
Sheets("Sheet2").[a:j].ClearCont ...
准提部林發表於 2021-10-24 16:54

感謝准大幫忙,完全符合要求。再次感謝閣下幫忙。謝謝

作者: Andy2483 時間: 2023-11-14 08:46

本帖最後由 Andy2483 於 2023-11-14 10:14 編輯

回復 3# 准提部林

謝謝論壇,謝謝前輩指導
後學學習前輩的方案,心得註解如下,請前輩再指導

Option Explicit
Sub TEST_A1()
Dim Arr, Brr, i&, N&, R&, j%, k%, Cn%, V%, V1%, V2%
'↑宣告變數:(Arr,Brr)是通用型變數,(N,R)是長整數,(j,k,Cn,V,V1,V2)是短整數
Sheets("Sheet2").[a:j].ClearContents
'↑令名為"Sheet2" 工作表的A:J欄儲存格清除內容
Arr = Range(Sheets("Sheet1").[j1], Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp)(2))
'↑令Arr這通用型變數是二維陣列,以表1的[J1]到A欄最後有內容儲存格的下一格,以此範圍儲存格值帶入Arr陣列中
ReDim Brr(1 To 30000, 1 To 10)
'↑宣告Brr這通用型變數是二維空陣列,縱向範圍從索引號1到30000,橫向範圍從索引號1 到10
For i = 2 To UBound(Arr) - 1
'↑設順迴圈!i從2 到Arr陣列縱向最大索引列號-1
  V = IIf(Arr(i, 10) = "HT", 1000, 3000) '除數
'↑令V這短整數是 IIF()回傳值:如果i迴圈列第10欄Arr陣列值自字串 "HT",True回傳數值1000,False回傳數值 3000
V1 = Val(Arr(i, 7)) '數量
'↑令V1這短整數是 i迴圈列第7欄Arr陣列值轉成數值
Cn = Int(V1 / V) + 1 '分拆行數
'↑令Cn這短整數是 V1變數除以V變數後去除小數的整數值+1
V2 = V1 Mod V '餘數
'↑令V2這短整數是 V1變數除以V變數的餘數
If V2 < 101 And Cn > 1 Then Cn = Cn - 1: V2 = V + V2
'↑如果V2變數<101 且Cn變數>1 ? True就令Cn變數-1:令V2變數是自身累加V變數
For j = 1 To Cn
'↑設順迴圈!j從1 到Cn變數
      N = N + 1
      '↑令N變數累加1
      For k = 1 To 10: Brr(N, k) = Arr(i, k): Next
      '↑設順迴圈!令k從1到10:將i列k變數欄Arr陣列值帶入 N變數列k變數欄Brr陣列中
      Brr(N, 7) = IIf(j = Cn, V2, V)
      '↑令N變數列第7欄陣列值是IIF()回傳值: 如果j變數同Cn變數!回傳V2變數,否則回傳V變數
Next j
If Arr(i, 8) <> Arr(i + 1, 8) And N Mod 2 = 1 Then N = N + 1
'↑如果i迴圈列第8欄Arr陣列值與下一列第8欄Arr陣列值不同,且N變數除以2的餘數是1?
'True就令N變數累加1
Next i
Sheets("Sheet2").[a1:j1] = Sheets("Sheet1").[a1:j1].Value
'↑令表2的標題列同表1的標題列
Sheets("Sheet2").[a2].Resize(N, 10) = Brr
'↑令表2的[A2]擴展向下N變數列,擴展向右10欄的範圍儲存格值以Brr陣列值帶入
End Sub
===========================================================

Option Explicit
Sub TEST()
Dim Brr, Crr, V%, V1%, Q%, i&, j%, R&
Dim S1 As Worksheet, S2 As Worksheet
Set S1 = Sheets("Sheet1"): Set S2 = Sheets("Sheet2")
Brr = Range(S1.[J1], S1.Cells(Rows.Count, "A").End(3))
ReDim Crr(1 To 10000, 1 To 10)
For i = 2 To UBound(Brr)
Q = Val(Brr(i, 7))
V = IIf(Brr(i, 10) = "HT", 1000, 3000)
qq:
If Q <= 0 Then GoTo i01 Else R = R + 1: V1 = Q - V
For j = 1 To 10: Crr(R, j) = Brr(i, j): Next
Crr(R, 7) = V * -(V1 >= 0) + Q * -(V1 < 0)
Q = V1: GoTo qq
i01: Next
S2.[A:J].ClearContents
S2.[A1:J1] = S1.[A1:J1].Value
S2.[a2].Resize(R, 10) = Crr
Set S1 = Nothing: Set S2 = Nothing: Erase Brr, Crr
End Sub

作者: hcm19522 時間: 2023-11-14 11:39

(輸入編號12006) google網址:https://hcm19522.blogspot.com/

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