2016-12-11 72 views
0

我在Excel中有一個自動過濾的表格。我必須根據特定條件複製粘貼值,我必須在特定列中的所有可見單元格上執行此操作。我寫了代碼,它運行良好,但唯一的問題是它有很多行需要很長時間。任何人都可以請幫助我如何捶打時間?這是代碼。謝謝!使用偏移量轉到下一個可見單元格

Sub TrialAnotherOne() 


Windows("Epson Itemcodes.xlsm").Activate 
    Range("A" & i).Select 
    Selection.Copy 

Windows("Epson ASINs.xlsx").Activate 
    Range("U1048576").End(xlUp).Offset(0, -12).Select 


If ActiveCell.Value <> "Itemcode" Then 

If ActiveCell.Value = "" Then 
    ActiveSheet.Paste 

    Else 

    If ActiveCell.Value = Workbooks("Epson Itemcodes.xlsm").Sheets("Sheet1").Range("A" & i).Value Then 
    ActiveSheet.Paste 

    Else 
    ActiveCell.Value = "Conflct" 

    End If 
    End If 

Else 
Windows("Epson Itemcodes.xlsm").Activate 
Range("I" & i).Value = "No match found" 

End If 

If ActiveCell.Value <> "Itemcode" Then 


With ActiveSheet 
Do 

ActiveCell.Offset(-1, 0).Activate 
Do While ActiveCell.EntireRow.Hidden = True 
ActiveCell.Offset(-1, 0).Activate 
Loop 

If ActiveCell.Value <> "Itemcode" Then 

If ActiveCell.Value = "" Then 
    ActiveSheet.Paste 

    Else 

    If ActiveCell.Value = Workbooks("Epson Itemcodes.xlsm").Sheets("Sheet1").Range("A" & i).Value Then 
    ActiveSheet.Paste 

    Else 

    ActiveCell.Value = "Conflct" 

    End If 
    End If 

Else 
Exit Do 

End If 

Loop 
End With 

End If 

End Sub 
+0

你應該看這個視頻系列:Excel的VBA簡介】(https://www.youtube.com/playlist?list=PLNIs-AWhQzckr8Dgmgb3akx_gFMnpxTN5)。這是必須的:[Excel VBA簡介第5部分 - 選擇單元格(範圍,單元格,活動單元格,結束,偏移)](https://www.youtube.com/watch?v=c8reU-H1PKQ&index=5&list=PLNIs- AWhQzckr8Dgmgb3akx_gFMnpxTN5&t = 3082s) –

+0

你應該將你的問題轉到代碼審查,這裏是鏈接:http://codereview.stackexchange.com/ –

回答

1

範圍複製,剪切和刪除自動僅選擇過濾範圍的可見單元格。

enter image description here

Sub CopyFilteredColumn() 
    Dim Target As Range 

    'Size the Target range to fit the table 
    'Define the starting row "C1:J19" 
    'Extend the Target range to the last row .Range("C" & .Rows.Count).End(xlUp) 
    'Column C is used because it will never have blank cells 
    With Worksheets("Source Sheet") 
     Set Target = .Range("C1:J19", .Range("C" & .Rows.Count).End(xlUp)) 
    End With 

    Target.AutoFilter Field:=1, Criteria1:=">40", Operator:=xlAnd 

    'Header and data 
    'Copy the visible cells of the 3rd column of the table 
    Target.Columns(3).Copy Worksheets("Target Sheet").Range("A1") 
    'Data only - Includes 1 blank cell at the end 
    Target.Offset(1).Columns(3).Copy Worksheets("Target Sheet").Range("C1") 

End Sub 
相關問題