Re: [算表]如何讓Excel判斷"已過期的資料列"，並搬 …
※ 引述《dorng (東)》之銘言：
: 軟體:Office Excel
: 版本:2003
: 檔案內有「A」和「B」兩張工作表，A的格式如下：
: ┌─────┬───┬─────┐
: │收件日期 │主旨 │到期日 │
: ├─────┼───┼─────┤
: │2006/12/1 │XXX │2007/1/1 │
: ├─────┼───┼─────┤
: │2009/07/13│AAA │2009/12/1 │
: └─────┴───┴─────┘
: ：
: ：
: ：
: 我想撰寫一個巨集，讓Excel進行下述動作...
: [舉例]
: 第一列的「到期日」資料為2007/01/01，而今天是2009/07/13，
: 所以第一列資料(整列資料)會被搬移至B工作表。第二列則不會。
: 請問該如何撰寫成巨集程式？這樣的描述是否清楚呢？
: p.s「A」工作表內的資料列數並不一定，大約在50-70筆左右。
Option Explicit
' 將已到期之資料列搬移
' 2009.07.13
Sub MoveDeadlineData()
Dim rangeCheck As Range ' 目前確認的儲存格
Dim rangeNextCheck As Range
Dim rangeDest As Range
Const strSourceSheet As String = "SheetA" ' 來源資料表名稱
Const strSourceColumn As String = "C" ' 到期日欄位
Const strDestSheet As String = "SheetB" ' 目的資料表名稱
Dim numCopy As Integer
numCopy = 0
' 先移至"到期日欄"最後一個有資料的儲存格
Set rangeCheck = Sheets(strSourceSheet).Columns(strSourceColumn).Find( _
what:="*", LookIn:=xlValues, searchdirection:=xlPrevious)
Set rangeDest = Sheets(strDestSheet).Range("A1")
' --- 由最後一列往上判斷、移動資料: ---
Do Until rangeCheck.Row = 1
Set rangeNextCheck = rangeCheck.Offset(-1, 0)
If CInt(DateDiff("d", Now, rangeCheck.Value)) < 0 Then
rangeCheck.EntireRow.Copy
rangeDest.Insert shift:=xlDown
Application.CutCopyMode = False
rangeCheck.EntireRow.Delete shift:=xlUp
numCopy = numCopy + 1
Else
' Do nothing
End If
Set rangeCheck = rangeNextCheck
Loop
' --- 輸出訊息: ---
Dim Msg, Style, Title, Response
Msg = "總共搬移了: " & Str(numCopy) & " 筆資料"
Style = vbOKOnly
Title = "報告"
Response = MsgBox(Msg, Style, Title)
' --- 釋放物件: ---
Set rangeCheck = Nothing
Set rangeNextCheck = Nothing
Set rangeDest = Nothing
End Sub
--
問題:
1. B工作表原有的資料會被往下移
2. 若A資料表資料中間有空白列會出錯
3. 未做防呆項目(ex:檢查工作表是否存在、中間空白列、到期日格式不是日期…)
4. 輸出訊息的部分若不需要可拿掉
5. 不確定是否符合需求，請提供工作表或自行進一步測試
視結果再討論看看~
6. 若程式用法有不妥當的地方，請大家告知~謝謝
--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 122.122.216.53
※ 編輯: lantolerance 來自: 122.122.217.20 (07/14 07:31)
推
07/16 09:16, , 1F
07/16 09:16, 1F
→
07/16 10:47, , 2F
07/16 10:47, 2F
討論串 (同標題文章)
本文引述了以下文章的的內容：
完整討論串 (本文為第 2 之 2 篇)：