麻辣家族討論版版 - Powered by Discuz! Board

Sub 分Job1()
Dim DataBase As Range
With Sheets("中銀支票")
Set DataBase = .Range("a5").CurrentRegion
'CurrentRegion 屬性傳回 Range 物件，該物件代表目前的區域。目前區域是指以任意空白列及空白欄的組合為邊界的範圍。唯讀
.Cells(1, .Columns.Count) = DataBase.Cells(1, DataBase.Columns.Count) '工作表最後一欄=DataBase最後一欄的標名(job number )
DataBase.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True
'AdvancedFilter(進階篩選) 方法基於準則範圍從資料清單中篩選或複製資料。如果初始選定為單個儲存格，則使用儲存格目前的區域x為Variant。
i = 2
.AutoFilterMode = False
'AutoFilterMode 屬性定如果目前在工作表上顯示有 [自動篩選] 下拉箭號，則此屬性為 True。該屬性與 FilterMode 屬性互相獨立。讀/寫 Boolean。
'備註如果目前顯示 [自動篩選] 下拉箭號，此屬性傳回 True。可將該屬性設定為 False，以移除該箭號，但無法將其設定為 True。可用 AutoFilter 方法對資料清單進行篩選並顯示該下拉箭號。
On Error GoTo Err_Sheet
'On Error 陳述式啟動一個錯誤處理常式，且指定此常式在一個程序裏的位置。也可用來停止一個錯誤處理常式。
Do While .Cells(i, .Columns.Count) <> "" '執行回圈的條件:中銀支票最後一欄的i列 <>""
DataBase.AutoFilter Field:=DataBase.Columns.Count, Criteria1:=.Cells(i, .Columns.Count)
'AutoFilter 方法使用 [自動篩選] 篩選出一個清單。為 Variant。
With Sheets(.Cells(i, .Columns.Count).Value).Range("a5")
.CurrentRegion = ""
DataBase.Copy .Cells
End With
i = i + 1
Loop
.AutoFilterMode = False
.Columns(.Columns.Count) = "" '清除進階篩選於最後一欄的資料
End With
Exit Sub
Err_Sheet:
If Err = 9 Then
With Sheets("中銀支票")
Sheets.Add , Sheets(Sheets.Count) '插入新的工作表
' .Copy , Sheets(Sheets.Count) '複製 "中銀支票" 工作表(格式如中銀支票)
ActiveSheet.Name = .Cells(i, .Columns.Count) '制定新工作表的名稱
' ActiveSheet.AutoFilterMode = False '複製 "中銀支票" 需顯示所有資料
End With
Resume
'Resume 陳述式在錯誤處理常式結束後 , 恢復原有的執行
Else
MsgBox "程式錯誤錯誤碼" & vbLf & Err
End If
End Sub

複製代碼