- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
7#
發表於 2014-8-16 09:12
| 只看該作者
本帖最後由 GBKEE 於 2014-8-16 11:50 編輯
回復 6# bridetobe
試試看- Option Explicit
- Sub 讀出()
- Dim a_date, Rng(1 To 2) As Range
- Application.Calculation = xlCalculationManual '手動計算
- Application.StatusBar = False
- With Sheets("操作")
- Set Rng(1) = .[A2:F2]
- Set Rng(2) = .Cells(1, .Columns.Count)
- .Range(Rng(1)(2, 1), Rng(1).End(xlDown)).Resize(, 7) = ""
- .[B1].Value = InputBox("輸入日期(例2014/7/1):", , "2014/7/1")
- Rng(2) = "日期"
- Rng(2).Offset(1) = .[B1]
- 'AdvancedFilter 進階篩選
- '進階篩選:的準則範圍 -> Rng(2).Resize(2)
- Sheets("存貨資料").UsedRange.AdvancedFilter xlFilterCopy, Rng(2).Resize(2), Rng(1)
- Rng(2).EntireColumn = ""
- If Rng(1).End(xlDown).Row <> .Rows.Count Then
- Set Rng(2) = Rng(1).Cells(2, 1)
- Do While Rng(2) <> ""
- Rng(2).Cells(1, "G") = 上一個小計(.[B1], Rng(2).Text) - Rng(2).Cells(1, "F")
- If Rng(2).Cells(1, "G") < 0 Then Rng(2).Cells(1, "G") = 0
- Set Rng(2) = Rng(2).Cells(2)
- Loop
- MsgBox "Ok"
- Else
- MsgBox "沒有資料"
- End If
- End With
- ' Application.Calculation = xlAutomatic '自動計算
- '自動篩選後會有工作表重算的動作,程式會等候重算完畢,再繼續執行下去.
- End Sub
- 'AutoFilter: 自動篩選
- Private Function 上一個小計(日期 As String, 品名 As String) As Integer
- Dim Rng As Range
- With Sheets("存貨資料").UsedRange
- '自動計算:當自動篩選後會有工作表重算的動作,影響程式執行的速度
- '自動篩選 指定欄位,準則
- .AutoFilter 1, ">" & 日期
- .AutoFilter 2, "=" & 品名
- Set Rng = .SpecialCells(xlCellTypeVisible)
- If Rng.Areas(1).Rows.Count > 1 Then
- 上一個小計 = Rng.Areas(1).Cells(2, "g")
- Else
- 上一個小計 = Rng.Areas(2).Cells(1, "g")
- End If
- End With
- End Function
|
|
發表於 2014-7-11 09:03
| 
