回復 10#adam2010
謝謝前輩測試回覆
做了心得註解更發現自己許多沒必要的可簡化的程式碼!
檢視出了很多邏輯上的缺點!
拋磚引玉!請前輩們指導如何簡化!或其他方法! 謝謝!
以下心得供前輩參考
Option Explicit
Public PP&, Ch0, Ch1
Sub 橫向往前攤平()
Application.ScreenUpdating = False
Dim Brr, Crr, i&, j&, x&, Tj&, Ti&, y, xA, Sc&, Sr&, R$
Dim Ra, Rs, Rn, Avgd&, Avgv, M0&, M1&, Sv, Cc, Bc, K, H
'↑宣告變數
Ch0 = 0: Ch1 = 0
'↑令Ch0是0,令Ch1是0
Set xA = Sheets("PP").Cells
'↑令xA是 "PP" 工作表的所有儲存格
Set y = CreateObject("Scripting.Dictionary")
'↑令y是字典
For Each Ra In xA.SpecialCells(2)
'↑設定迴圈去找xA非空格裡右上角跟左下角是 "總計" 的儲存格位址
Rn = IIf(Ra = "總計" And Rn = "" And Rs <> "", Ra.Address, Rn)
'↑令Rn是左下角的 "總計" 儲存格位址
'把這行擺在前面的用意是:
'右上角的 "總計" 儲存格位址如果還沒找到! And Rs <> ""這條件就不成立
'And Rn = ""是只認定第二個 "總計" 儲存格位址
Rs = IIf(Ra = "總計" And Rs = "", Ra.Address, Rs)
'↑令Rn是右上角的 "總計" 儲存格位址
Next
Brr = xA.Range(Rs, Rn)
'↑令Brr是兩個總計儲存格範圍的值陣列
Bc = UBound(Brr, 2)
'↑令Bc是Brr橫方向的欄數
Rs = Brr(1, 8)
'↑令Rs是第一列第八欄這值(有訂單的開始日期)
Rn = Brr(1, Bc - 1)
'↑令Rn是第一列倒數第二個值(有訂單的最後日期)
Sc = Rn - Rs + 1
'↑令Sc是頭尾區間的天數!一定要加1才能包含最後一天
Sr = UBound(Brr) - 2
'↑令Sr是Brr的列數減掉2列
Ch0 = Brr(UBound(Brr, 1), UBound(Brr, 2))
'↑令Ch0是最右下角的值(總合計)
ReDim Crr(1 To Sr + 2, 1 To Sc + 1)
'↑宣告Crr這空陣列的範圍:縱方向Sr + 2 列
'橫方向Sc + 1 欄
Cc = UBound(Crr, 2)
'↑令Cc是Crr的橫方向欄數
For i = 1 To Sc
'↑設迴圈把全部日期放到Crr陣列的第一列
'↑y字典也用這些序號當key,item設為0初始值,
'讓後面累加為當天攤平總和
Crr(1, i) = Rs + (i - 1)
y(i) = 0
Next
For i = 1 To UBound(Brr)
'↑設迴圈把原始右側的小計放入Crr的最後一欄
Crr(i, Cc) = Brr(i, Bc)
Next
For j = 2 To Sr + 1
'↑設迴圈把原始定單放入Crr的當日訂單位置
For i = 1 To Sc
For x = 8 To Bc - 1
If Brr(1, x) = Rs + (i - 1) Then
Crr(j, i) = Brr(j, x)
End If
Next
Next
Next
For x = 1 To Sr
'↑以下設三層迴圈把訂單往前攤平!且不必跨月攤平!
'↑先設正外迴圈
Avgd = 0: Avgv = 0: M0 = 0: M1 = 0
'↑Avgd:攤平天數,Avgv:攤平量,
'M0:前一個月的月數,M1:當格的月數
'做歸零
For j = Sc To 1 Step -1
'↑設中層倒迴圈!讓符合條件就填入攤平值
'不能攤平就填入原訂單值
'沒有訂單就空格
If j = 1 Then
y(j) = y(j) + Crr(x + 1, j)
Exit For
'↑如果倒迴圈能跑到j = 1,就讓合計加上原訂單量
',就跳出中層這迴圈
End If
M1 = Format(Crr(1, j), "mm")
'↑令M1是當格的訂單月份數
Tj = Crr(x + 1, j)
'↑令Tj是要判定須不須!能不能攤平的當格值
If Tj <> 0 And j = Sc Then
'↑如果當格值不是0 而且是最後一個日期訂單
Avgd = 1
'↑令可攤平天數=1
For i = j - 1 To 1 Step -1
'↑設內層倒迴圈!從j當格前一格開始到最前面那天
M0 = Format(Crr(1, i), "mm")
'↑令M0是i當格的月分數
Ti = Crr(x + 1, i)
'↑令Ti是要判定能不能吃下攤平值的當格
If Ti <> 0 And Avgd = 1 Then
'↑如果前方格的值不是0,且可攤平天數是1
If i = Sc - 1 Then
'↑如果i是倒數第二天
Avgd = 0
'↑條件成立!就可攤平天數=0
'因為沒得攤平
Else
Avgd = Avgd + 1
Avgv = Tj
'↑否則可攤平天數+1
'↑可被攤平的數量就是j的當格值
End If
y(j) = y(j) + Tj
'↑當天全部攤平總和要累加
GoTo 111
'↑跳到 111的位置繼續執行
End If
If (Ti <> 0 And Avgd > 1) Or M0 <> M1 Then
'↑(如果前方格不是0且可攤平天數大於1)或月數已經不一樣了
GoTo 111
'↑跳到 111的位置繼續執行
End If
If Ti = 0 Then
'↑如果前方格是0
Avgd = Avgd + 1
'↑可攤平天數+1
Avgv = Round(Tj / Avgd, PP)
'↑攤平值=須攤平值除以可攤平天數之後四捨五入取整數
End If
Next i
End If
If Tj <> 0 And j <> Sc Then
'↑如果當格值不是0 而且不是最後一個日期訂單
Avgd = 1
'↑令可攤平天數=1
For i = j - 1 To 1 Step -1
'↑設內層倒迴圈!從j當格前一格開始到最前面那天
M0 = Format(Crr(1, i), "mm")
'↑令M0是i當格的月分數
Ti = Crr(x + 1, i)
'↑令Ti是要判定能不能吃下攤平值的當格
If Ti <> 0 And Avgd = 1 Then
'↑如果前方格的值不是0,且可攤平天數是1
Avgv = Tj
'↑可被攤平的數量就是j的當格值
GoTo 111
'↑跳到 111的位置繼續執行
End If
If Ti = 0 And M0 <> M1 And Avgd = 1 Then
'↑如果前方格是0且可攤平天數等於1且月數已經不一樣了
Avgv = Tj
'↑可被攤平的數量就是j的當格值
End If
If (Ti <> 0 And Avgd > 1) Or M0 <> M1 Then
'↑(如果前方格不是0且可攤平天數大於1)或月數已經不一樣了
GoTo 111
'↑跳到 111的位置繼續執行
End If
If Ti = 0 Then
'↑如果前方格是0
Avgd = Avgd + 1
'↑可攤平天數+1
Avgv = Round(Tj / Avgd, PP)
'↑攤平值=須攤平值除以可攤平天數之後四捨五入取整數
End If
Next i
End If
111
If Avgd > 1 And Avgv <> 0 Then
'↑如果可攤平天數大於1 且 攤平值不等於 0
Crr(x + 1, j) = Avgv
'↑就把攤平值倒入相對位置
Avgd = Avgd - 1
'↑可攤平天數就減1
'可攤平天數因為後面GoTo 111 就必須減到條件不成立
y(j) = y(j) + Avgv
'↑當天全部攤平總和要累加
j = j - 1
'↑j當格的前一天被用掉了!j就要前進一格
GoTo 111
'↑跳到 111位置執行
ElseIf Avgd = 1 And Avgv <> 0 Then
'↑否則如果可攤平天數等於1 且 攤平值不等於 0
Crr(x + 1, j) = Avgv
'↑就把攤平值倒入相對位置
Avgd = Avgd - 1
'↑可攤平天數就減1
y(j) = y(j) + Avgv
'↑當天全部攤平總和要累加
Avgv = 0
'↑攤平值歸零
End If
Next j
Next x
For j = 1 To Sc
'↑設正迴圈讓當日合計放入Crr陣列最後一列
Crr(UBound(Crr), j) = y(j)
Next
For i = 2 To UBound(Crr) - 1
'↑設正迴圈把所有攤平與不能攤平的訂單值加起來
For x = 1 To UBound(Crr, 2) - 1
Ch1 = Ch1 + Crr(i, x)
'↑Ch1加到最後就是攤平後的總合計
Next
Next
With Sheets("PP-平均")
'↑下面是有關工作表的程序
.UsedRange.Offset(1, 0).EntireRow.Delete
'↑把工作表有使用的列往下偏移一列的範圍刪除
