- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2013-4-13 15:53
| 只看該作者
本帖最後由 GBKEE 於 2013-4-13 15:55 編輯
回復 1# Hero2013
試試看- 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
|
|
發表於 2013-4-13 10:36
| 
