2016-12-11 48 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 
相关问题