分割工作表range放變數進去後執行速度變慢

lamb22368

大家好，想請教在指定工作表裡range使用變數時，執行的速度不知為何變得非常慢，連帶刪除工作表時也顯得卡卡的；
但如果改成指定範圍速度就很快，但資料不一定每次都一樣多列，想知道有沒有加快運行的方法，非常感謝~

下列這些容易拖慢excel的功能也都試過，執行起來一樣很慢...

    Application.Calculation = xlCalculationManual  '暫停公式自動計算
    Application.ScreenUpdating = False  '暫停畫面更新
    Application.DisplayStatusBar = False '暫停狀態列更新
    Application.EnableEvents = False  '暫停事件處理
    Application.Interactive = False  '暫停交互模式

我的檔案：[attach]31643[/attach]

lamb22368

糟糕我不會上傳附件
分割工作表range放變數執行速度變慢.rar (25.74 KB)

檔案
下載次數: 9

2020-1-15 15:57

Public Sub 批次分割工作表()
    '複製業務到Z欄
    Columns("A:A").Copy
    Columns("Z:Z").Insert shift:=xlToRight

    '移除重複
    ActiveSheet.Range("Z:Z").RemoveDuplicates Columns:=1, Header:=xlYes

   
    '新增工作表
    For i = 2 To Range("Z1").End(xlDown).Row
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Sheets(1).Cells(i, "Z")
        
        '不知為何range丟變數進去執行速度變很慢
'        r = Range("A1").End(xlDown).Row
'        Sheets(1).Range("A1:U" & r).AutoFilter field:=1, Criteria1:=Sheets(1).Cells(i, "Z") '篩選這個功能是在Range物件底下的方法
'        Sheets(1).Range("A1:U" & r).Copy Range("A1")
        
        
        '直接指定範圍運行速度就很快
        Sheets(1).Range("A1:U14").AutoFilter field:=1, Criteria1:=Sheets(1).Cells(i, "Z") '篩選這個功能是在Range物件底下的方法
        Sheets(1).Range("A1:U14").Copy Range("A1")
    Next
   
    Sheets(1).Select
    Columns("Z").Delete
    Sheets(1).Range("A1:U14").AutoFilter
   
End Sub

jcchiang

回復 2# lamb22368

你的r是算到新開的Page的Row
r = Range("A1").End(xlDown).Row
請改成
r = Sheets(1).Range("A1").End(xlDown).Row
並改放到外層,否則當程式執行篩選後r值會跟著改變,無法篩選出正確資料

Public Sub 批次分割工作表()
    '複製業務到Z欄
    Columns("A:A").Copy
    Columns("Z:Z").Insert shift:=xlToRight

    '移除重複
    ActiveSheet.Range("Z:Z").RemoveDuplicates Columns:=1, Header:=xlYes
    r = Sheets(1).Range("A1").End(xlDown).Row
   
    '新增工作表
    For i = 2 To Range("Z1").End(xlDown).Row
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Sheets(1).Cells(i, "Z")
        
        '不知為何range丟變數進去執行速度變很慢
    '    r = Sheets(1).Range("A1").End(xlDown).Row
        Sheets(1).Range("A1:U" & r).AutoFilter field:=1, Criteria1:=Sheets(1).Cells(i, "Z") '篩選這個功能是在Range物件底下的方法
        Sheets(1).Range("A1:U" & r).Copy Range("A1")        
        
        '直接指定範圍運行速度就很快
'        Sheets(1).Range("A1:U14").AutoFilter field:=1, Criteria1:=Sheets(1).Cells(i, "Z") '篩選這個功能是在Range物件底下的方法
'       Sheets(1).Range("A1:U14").Copy Range("A1")
    Next
   
    Sheets(1).Select
    Columns("Z").Delete
    Sheets(1).Range("A1:U14").AutoFilter
   
End Sub

lamb22368

回復 3# jcchiang


    我理解了，非常感謝說明與指導~

准提部林

Public Sub 批次分割工作表()
Dim xD, xArea As Range, xR As Range
Set xD = CreateObject("Scripting.Dictionary")
Set xArea = Range("U1", Cells(Rows.Count, 1).End(xlUp))
For Each xR In xArea.Columns(1).Cells
    If xR.Row = 1 Or xR = "" Or xD(xR & "") > 0 Then GoTo 101 Else xD(xR & "") = 1
    xArea.AutoFilter field:=1, Criteria1:=xR.Value
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = xR.Value
    xArea.Copy Sheets(xR.Value).[A1]
101: Next
xArea.Parent.Select
ActiveSheet.AutoFilterMode = False
End Sub


'==========================================

lamb22368

回復 5# 准提部林


    謝謝版主提供～好顛覆我的腦袋，菜鳥我需要仔細推敲，再次感謝版主～