- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
4#
發表於 2015-7-4 06:59
| 只看該作者
回復 3# united7878
試試看- Option Explicit
- Sub Ex()
- Dim Rng As Range, Quantity(1 To 2) As Integer, Total(1 To 2) As Double
- Dim Sh As Worksheet, i(1 To 2) As Integer
- Set Rng = Sheets("C").[B2]
- Set Sh = Sheets.Add '新增工作表
- Do While Rng <> ""
- With Sheets("A")
- .Range("a1").AutoFilter Field:=2, Criteria1:=Rng
- Quantity(1) = Application.Sum(.Range("d:d").SpecialCells(xlCellTypeVisible))
- Total(1) = Application.Sum(.Range("E:E").SpecialCells(xlCellTypeVisible))
- End With
- With Sheets("B")
- .Range("a1").AutoFilter Field:=2, Criteria1:=Rng
- Quantity(2) = Application.Sum(.Range("d:d").SpecialCells(xlCellTypeVisible))
- Total(2) = Application.Sum(.Range("E:E").SpecialCells(xlCellTypeVisible))
- End With
- With Rng
- .Cells(1, 2) = Quantity(1) - Quantity(2) '庫存數量
- If .Cells(1, 2) > 0 Then '有庫存數量
- If Total(2) > 0 Then '銷貨數量
- Total(2) = 0
- i(1) = .Cells(1, 2)
- With Sh
- .UsedRange.Clear
- Sheets("A").UsedRange.Copy .[A1] '複製: A表自動篩選後的數值
- i(2) = .UsedRange.Rows.Count '資料的最後一列
- Do While i(1) > 0 '庫存數大於 0
- Do While .Cells(i(2), "D") > 0 And i(1) > 0
- Total(2) = Total(2) + .Cells(i(2), "c")
- i(1) = i(1) - 1 '庫存數 - 1
- .Cells(i(2), "D") = .Cells(i(2), "D") - 1 '進貨數量 -1
- Loop
- i(2) = i(2) - 1 '資料列 上移 一列
- Loop
- End With
- .Cells(1, 3) = Round(Total(2) / .Cells(1, 2), 1)
- Else ' 銷貨數量為0
- .Cells(1, 3) = Round((Total(1) - Total(2)) / .Cells(1, 2), 1)
- End If
- Else '沒有庫存數量
- .Cells(1, 3) = 0
- End If
- End With
- Set Rng = Rng.Offset(1)
- Loop
- Application.DisplayAlerts = False
- Sh.Delete '刪除:新增的工作表
- Application.DisplayAlerts = True
- End Sub
|
|
發表於 2015-6-26 07:32
| 
