- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
2#
發表於 2021-7-28 13:18
| 只看該作者
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 |
|
