篩選後不隱藏_延伸帖_請前輩們指導陣列哪裡設錯了

Andy2483

各位前輩午安!
1.附件是試著將 篩選後不隱藏 這帖的入出庫資料由橫式改為直式
1.1.目的是要分享樓主直式資料的好處
1.2.主要目的是要學習陣列方式的語法

2.以下兩個程式碼 ANDY認為應該結果會一樣!
請教各位前輩 是哪裡錯了!

謝謝各位前輩指導!

Andy2483

Option Explicit
Sub 小計()
Call 全部顯示
Call 排序

Dim Er&, Arr(), Brr(), i, xF, xE
[AS:AS].ClearContents
[AS13] = "月_機種_品名_料號"
Er = ActiveSheet.UsedRange.Rows.Count
If Range("A" & Er) = "左鍵雙按刪除此列" Then
   Rows(Er).Delete
   Er = ActiveSheet.UsedRange.Rows.Count
End If
Arr = Range([A1], Range("AO" & Er))
ReDim Brr(1 To Er - 13)
For i = 14 To UBound(Arr)
   Cells(i, 45) = Format(Cells(i, 37), "yyyy/mm") & "_機種:" & Cells(i, 5) & "_品名:" & Cells(i, 9) & "_料號:" & Cells(i, 13)
Next
Range("E13:AS" & ActiveSheet.UsedRange.Rows.Count).Subtotal GroupBy:=41, Function:=xlSum, TotalList:=Array(21, 25, _
        29), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Cells.ClearOutline ' 刪大綱
xE = ""
For i = 14 To ActiveSheet.UsedRange.Rows.Count
   xF = Cells(i, "AS")
   If xF Like "*合計*" = True Then
      Cells(i - 1, "U").Interior.ColorIndex = 35
   End If
   If xF Like "*計*" = True Then
      Rows(i).Interior.ColorIndex = 36
      Rows(i).Value = Rows(i).Value
      GoTo 9999
   End If
   If xF <> xE Then
      If Cells(i, "Q") = "" Then
         Cells(i, "Q").Interior.ColorIndex = 3
         MsgBox Cells(i, "AS") & "沒有上月庫存資料!" & Chr(10) & Chr(10) & _
                "執行中斷! 請修正後再重新執行!"
         ActiveWindow.ScrollRow = i - 10
         Exit Sub
      End If
      Cells(i, "U") = ""
      Cells(i, "U") = Cells(i, "Q") + Cells(i, "Y") - Cells(i, "AC") + Cells(i, "AG")
      xE = Cells(i, "AS")
      Else
         Cells(i, "Q") = ""
         Cells(i, "U") = Cells(i - 1, "U") + Cells(i, "Q") + Cells(i, "Y") - Cells(i, "AC") + Cells(i, "AG")
         Cells(i, "U").Interior.ColorIndex = xlNone
   End If
   
9999
Next
End Sub


Option Explicit
Sub 小計_ERR()
Call 全部顯示
Call 排序

Dim Er&, Arr(), Brr(), i, xF, xE
[AS:AS].ClearContents
[AS13] = "月_機種_品名_料號"
Er = ActiveSheet.UsedRange.Rows.Count
If Range("A" & Er) = "左鍵雙按刪除此列" Then
   Rows(Er).Delete
   Er = ActiveSheet.UsedRange.Rows.Count
End If
Arr = Range([A1], Range("AO" & Er))
ReDim Brr(1 To Er - 13)
For i = 14 To UBound(Arr)
   Brr(i - 13) = Format(Cells(i, 37), "yyyy/mm") & "_機種:" & Arr(i, 5) & "_品名:" & Arr(i, 9) & "_料號:" & Arr(i, 13)
Next
[AS14].Resize(UBound(Brr)) = Brr
Range("E13:AS" & ActiveSheet.UsedRange.Rows.Count).Subtotal GroupBy:=41, Function:=xlSum, TotalList:=Array(21, 25, _
        29), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Cells.ClearOutline ' 刪大綱
xE = ""
For i = 14 To ActiveSheet.UsedRange.Rows.Count
   xF = Cells(i, "AS")
   If xF Like "*合計*" = True Then
      Cells(i - 1, "U").Interior.ColorIndex = 35
   End If
   If xF Like "*計*" = True Then
      Rows(i).Interior.ColorIndex = 36
      Rows(i).Value = Rows(i).Value
      GoTo 9999
   End If
   If xF <> xE Then
      If Cells(i, "Q") = "" Then
         Cells(i, "Q").Interior.ColorIndex = 3
         MsgBox Cells(i, "AS") & "沒有上月庫存資料!" & Chr(10) & Chr(10) & _
                "執行中斷! 請修正後再重新執行!"
         ActiveWindow.ScrollRow = i - 10
         Exit Sub
      End If
      Cells(i, "U") = ""
      Cells(i, "U") = Cells(i, "Q") + Cells(i, "Y") - Cells(i, "AC") + Cells(i, "AG")
      xE = Cells(i, "AS")
      Else
         Cells(i, "Q") = ""
         Cells(i, "U") = Cells(i - 1, "U") + Cells(i, "Q") + Cells(i, "Y") - Cells(i, "AC") + Cells(i, "AG")
         Cells(i, "U").Interior.ColorIndex = xlNone
   End If
   
9999
Next
End Sub

Andy2483

差異處如下:

OK:
For i = 14 To UBound(Arr)
   Cells(i, 45) = Format(Cells(i, 37), "yyyy/mm") & "_機種:" & Cells(i, 5) & "_品名:" & Cells(i, 9) & "_料號:" & Cells(i, 13)
Next

ERR:
For i = 14 To UBound(Arr)
   Brr(i - 13) = Format(Cells(i, 37), "yyyy/mm") & "_機種:" & Arr(i, 5) & "_品名:" & Arr(i, 9) & "_料號:" & Arr(i, 13)
Next
[AS14].Resize(UBound(Brr)) = Brr

Andy2483

Andy上傳的範例檔犯了嚴重錯誤
雖然很丟臉 還是要承認!
Sorry 請各位網友不要使用範例檔
如果可以的話 請小誌或版主刪除此帖
Andy對不起大家!

使用小計之後的總計不能直接變成值 會嚴重錯誤!
If xF Like "*計*" = True Then
      Rows(i).Interior.ColorIndex = 36
      Rows(i).Value = Rows(i).Value
      GoTo 9999
   End If