Option Explicit
Sub TEST()
Application.DisplayAlerts = False
Dim Brr, R&, i&, j&, Nsht$, Sht, M
Sht = Application.InputBox("請輸入銷匯或進匯", "工作表名稱", "銷匯", , , , , 2)
If InStr("銷匯/進匯", Sht) = 0 Then Exit Sub Else Nsht = Sht: Set Sht = Sheets(Sht)
M = Application.InputBox("請輸入月份", "工作表名稱", 3, , , , , 2)
If Val(M) = 0 Then Exit Sub Else Nsht = Nsht & M & "月"
Brr = Range(Sht.[P1], Sht.[A65536].End(3))
For i = 1 To UBound(Brr)
If Format(Brr(i, 2), "M") <> Val(M) And i <> 1 Then GoTo i01
R = R + 1: For j = 1 To 16: Brr(R, j) = Brr(i, j): Next
i01: Next
On Error Resume Next
Sheets(Nsht).Delete
With Worksheets.Add(after:=Worksheets(Sheets.Count))
.Name = Nsht
.[A1].Resize(R, 16) = Brr
.Columns(2).NumberFormatLocal = "yyyy-m-d"
.EntireColumn.AutoFit
End With
Erase Brr: Set Sht = Nothing
End Sub作者: Andy2483 時間: 2023-5-30 07:38
本帖最後由 Andy2483 於 2024-1-17 20:06 編輯
謝謝論壇,謝謝各位前輩
後學藉此帖複習昨天的方案,方案學習心得註解如下,請各位前輩指教
Option Explicit
Sub TEST()
Application.DisplayAlerts = False
'↑令不要再跳出詢問窗(問真的要刪除工作表嗎?),直接刪了!
Dim Brr, R&, i&, j&, Nsht$, Sht, M
'↑宣告變數
Sht = Application.InputBox("請輸入銷匯或進匯", "工作表名稱", "銷匯", , , , , 2)
'↑令Sht變數是 輸入窗的回傳結果
If InStr("銷匯/進匯", Sht) = 0 Then Exit Sub Else Nsht = Sht: Set Sht = Sheets(Sht)
'↑如果InStr()回傳 Sht變數不包含在字串裡!就結束程式,否則
'否則就令Nsht變數(字串)是 sht變數值,令Sht變數是名為 Sht變數的工作表
M = Application.InputBox("請輸入月份", "工作表名稱", 3, , , , , 2)
'↑令M變數是 輸入窗的回傳結果
If Val(M) = 0 Then Exit Sub Else Nsht = Nsht & M & "月"
'↑如果InStr()回傳值轉化為數值後是 0!就結束程式,否則
'否則令Nsht變數後面再連接 M變數,再連接 "月",成為新字串
Brr = Range(Sht.[P1], Sht.[A65536].End(3))
'↑令Brr變數是 二維陣列,以Sht變數(工作表)的A~P欄儲存格值帶入陣列中
For i = 1 To UBound(Brr)
'↑設順迴圈!
If Format(Brr(i, 2), "M") <> Val(M) And i <> 1 Then GoTo i01
'↑如果第2欄陣列值(日期)月份 不同於M變數轉化為的數值,
'而且i變數不是1,就跳到標示i01的位置繼續執行
R = R + 1: For j = 1 To 16: Brr(R, j) = Brr(i, j): Next
'↑令R變數記錄結果資料要放在第幾列,
'設順迴圈,將結果資料覆蓋掉原陣列資料,寫入符合條件的資料
i01: Next
On Error Resume Next
'↑令程序遇到錯誤不停下來,繼續進行下個程序
Sheets(Nsht).Delete
'↑令刪除名為 Nsht變數的工作表(如果沒有此工作表可刪除,會跳過)
With Worksheets.Add(after:=Worksheets(Sheets.Count))
'↑以下是關於在索引最後新增一個工作表的程序
.Name = Nsht
'↑令工作表名字是 Nsht變數所帶的字串
.[A1].Resize(R, 16) = Brr
'↑令[A1]儲存格擴展適當範圍寫入Brr陣列值,超過此範圍的陣列值忽略
.Columns(2).NumberFormatLocal = "yyyy-m-d"
'↑令B欄格式依照設定方式顯示
.EntireColumn.AutoFit
'↑令這範圍欄位自動調整欄寬
End With
Erase Brr: Set Sht = Nothing
'↑令釋放變數
End Sub作者: dou10801 時間: 2023-6-2 09:16
