複製和粘貼到表中更有效的方式

1.INFO（huuuge表，圍繞10.000行）
。2.加INFO

第二個是我的問題在哪裏。基本上它有兩個功能，要麼過濾（基於2個不同的標準），並搜索表中的信息，並將其顯示在表上或向表中添加新行。宏我做的工作很好，但它似乎不可思議，我認爲1分鐘時太長，它完成的任務：

Sub Search_in_table() 

Dim header As Range 


Sheets("ADD INFO").Select 
Range("A13").Select 
Range(Selection, Selection.End(xlToRight)).Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Delete Shift:=xlUp 

If Worksheets("ADD INFO").[Item_to_search] = "Cust_ID" Then 
    Sheets("INFO").Select 
    Set header = [A1:Y1] 
    With header 
     .AutoFilter Field:=6, Criteria1:=Worksheets("INFO").[What_I_Want] 
    End With 

ElseIf Worksheets("ADD INFO").[Item_to_search] = "ASIN" Then 
    Sheets("INFO").Select 
    Set header = [A1:Y1] 
    With header 
     .AutoFilter Field:=4, Criteria1:=Worksheets("INFO").[What_I_Want] 
    End With 

End If 

ActiveSheet.AutoFilter.Range.Copy 
Sheets("ADD INFO").Select 
Worksheets("ADD INFO").[A13].PasteSpecial 

Sheets("INFO").Select 
header.Select 
Selection.AutoFilter 

Sheets("ADD INFO").Select 

End Sub

這是一個增加一個新行：

Sub add_esc() 

Sheets("ADD INFO").Select 
Range("Y9:A9").Select 
Selection.Copy 

Sheets("INFO").Select 
Range("A1").Select 
Selection.End(xlDown).Select 
ActiveCell.Offset(1, 0).Select 

Selection.PasteSpecial 

Sheets("ADD INFO").Select 
Range("A9:Y9").Select 
Selection.ClearContents

有沒有辦法讓他們更有效率？我錯過了什麼？順便說一下，What_I_Want和Item_To_Search只是名稱的單元格。一個有趣的事實是，在編寫代碼的過程中，我在「selection.paste」這樣的東西中出現了很多奇怪的錯誤，這就是爲什麼我使用「Worksheets（」ADD INFO「）等不常見的符號。[A13] .PasteSpecial「

任何想法都非常感謝！提前致謝！

來源

2013-08-30 rodrigocf

我建議擺脫「選擇」和「激活」無論你可以，應該加快速度並最終避免錯誤。你能清除牀單上的所有細胞（「添加信息」）嗎？（「添加信息」）cells.clear

至於其餘的代碼：不記得做類似的事情，但理論聽起來不錯......擺脫所有那些「選擇」，但他們只是慢事情下降。當你已經有了：

ActiveSheet.AutoFilter.Range.Copy 
Sheets("ADD INFO").Select 
Worksheets("ADD INFO").[A13].PasteSpecial

，而不是僅僅使用額外信用的這個（和，而不是使用表（）直接引用張代號：

wsInfo.autofilter.range.copy wsAddInfo.cells(13,1) ' i.e. row 13, column 1 (col A)

不知道有關的其餘您問題重新：添加行等，但使用上面的方法，也許你只需要增加該複製目標行？或使用application.worksheetfunction.counta（範圍）來找到最後使用的單元格，而不是「選擇」等等...

您的方法可能實際上比j慢ust手動遍歷每一行並複製滿足條件的地方？也許值得嘗試一下。喜歡的東西：

for each rgCell in rgList 
    if rgCell.offset(0,4) = stCrit1 _ 
     and rgcell.offset(0,8) = stCrit2 then 
     rgcell.entirerow.copy wsAddInfo.cells(intDrawRow, intDrawCol) 
     intDrawRow = intDrawRow + 1 

    end if 
next

如果一切都失敗了，我強烈建議你擺脫在代碼中所有的「選擇」的這樣做，使用application.screenupdating =假在你的代碼開始前，和application.screenupdating = true在代碼的末尾。強烈建議錯誤處理，以便您也將屏幕更新設置爲錯誤。

Cheers，Si

來源

2013-08-30 04:01:02 Simon

複製和粘貼到表中更有效的方式

回答

相關問題