Andy2483

回復 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
   '↑把工作表有使用的列往下偏移一列的範圍刪除
   
   .[2:2].Font.Size = 10
   '↑令第二列字體大小是10
   
   .Range(.Cells(2, 8), .Cells(2, 8 + Cc)).NumberFormatLocal = "m/d;@"
   '↑令即將要放入日期的那幾格的格式是 月/日
   
   .[A2].Resize(UBound(Brr), Bc) = Brr
   '↑先將Brr陣列從A2開始倒入
   .[H2].Resize(UBound(Crr), Cc) = Crr
   '↑再將Crr陣列從H2開始倒入
   .UsedRange.Offset(1, 0).EntireRow.Borders.LineStyle = xlContinuous
   '↑讓儲存格顯示格線
   .[A1] = xA(1, 1)
   '↑把 "PP"工作表的[A1]值帶到此表[A1]
End With
Sheets("PP-平均").Activate
'↑畫面跳到 "PP-平均" 工作表
ActiveWindow.FreezePanes = False
'↑把凍結窗格取消
[H3].Activate: ActiveWindow.FreezePanes = True: [A1].Activate
'↑將H3為界線!讓左側欄位凍結!讓上方列位凍結
Set Brr = Nothing
Set Crr = Nothing
Set y = Nothing
End Sub
Sub 正式執行_檢查()
PP = 0
Call 橫向往前攤平
MsgBox "**誤差量: " & Ch0 - Ch1 & "  **"
End Sub

adam2010

回復 11# Andy2483


    感謝Andy2483大不但協助回復還詳細說明，真是太有心了