八仙聚会，VBA找茬：您属哪路神仙？

zhangjianiam

VBA简化了许多工作，却因一些不必要的执行拖慢了速度，真让人好等。下面这段代码，我们就来找找茬，以资各位相互讨论学习之用。
八仙过海，一起来找茬，修理他，我们才顺气！

Sub Macro16() '13-15周岁花名册提取
    Sheets("总花名册").Select
    Rows("4:4").Select
    Range("N4").Activate
    Selection.AutoFilter
    Selection.AutoFilter Field:=7, Criteria1:=">=13", Operator:=xlAnd, _
        Criteria2:="<=15"
    Range("A5:G65520").Select
    Selection.Copy
    Sheets("13-15周岁花名册").Select
    Range("A8").Select
    ActiveSheet.Paste
    Sheets("总花名册").Select
    Range("L5:X65520").Select
    Range("X5").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("13-15周岁花名册").Select
    Range("H8").Select
    ActiveSheet.Paste
    Sheets("总花名册").Select
    ActiveWindow.ScrollColumn = 7
    Range("AD5:AE65520").Select
    Range("AE5").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("13-15周岁花名册").Select
    Range("U8").Select
    ActiveSheet.Paste
    Sheets("总花名册").Select
    Range("AK5:AK65520").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("13-15周岁花名册").Select
    Range("W8").Select
    ActiveSheet.Paste
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    Sheets("总花名册").Select
    Range("AN5:AN65520").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("13-15周岁花名册").Select
    Range("X8").Select
    ActiveSheet.Paste
    Sheets("总花名册").Select
    Range("AW5:AW65520").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("13-15周岁花名册").Select
    Range("Y8").Select
    ActiveSheet.Paste
    Range("C8").Select
    Sheets("总花名册").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    Range("AS10").Select
    Range("B3:B4").Select
    Sheets("13-15周岁花名册").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("B6:B7").Select
End Sub

ctp_119

兄弟，你这是录制的吧，看起来这么费劲。附件传上来呀
这段程序慢的理由就是选择对象太多，一下这个工作表，一下那个工作表，这样很费时，如果手工编程的话，一般都是采用变量来代替或用WITH来，这样一处理，我相信快很多。

[ 本帖最后由 ctp_119 于 2011-5-25 08:01 编辑 ]

zhangjianiam

13-15花名册提取代码.rar (113.51 KB, 下载次数: 60)

2011-5-25 08:24 上传

点击文件名下载附件

TFQWFN

“杰”真是专家了，服了，

ctp_119

Private Sub CommandButton1_Click()
Dim cell As Range, rng As Range
With Sheets("总花名册")
For Each cell In .Range("g5:g" & .Cells(Rows.Count, 7).End(xlUp).Row)
    If cell <= 15 And cell >= 13 Then
        If rng Is Nothing Then
           Set rng = cell.Offset(, -6).Resize(1, 25)
        Else
           Set rng = Union(rng, cell.Offset(, -6).Resize(1, 25))
        End If
    End If
Next
End With
rng.Copy Range("a8")
End Sub

ctp_119

原帖由 TFQWFN 于 2011-5-25 08:33 发表
“杰”真是专家了，服了，

兄弟，你这是损我呢，还是夸我哟！

TFQWFN

是真心的佩服你了，看了你EH上的表现众所周知

zhangjianiam

请 杰 对下面几条语句做个详细的说明。本人菜鸟，理解上有点困难。谢过了哈
  If rng Is Nothing Then
           Set rng = cell.Offset(, -6).Resize(1, 25)
        Else
           Set rng = Union(rng, cell.Offset(, -6).Resize(1, 25))

ctp_119

原帖由 zhangjianiam 于 2011-5-25 09:42 发表
请 杰 对下面几条语句做个详细的说明。本人菜鸟，理解上有点困难。谢过了哈
  If rng Is Nothing Then
           Set rng = cell.Offset(, -6).Resize(1, 25)
        Else
           Set ...

如果RANGE的RNG什么都没有，就给它赋值，赋值是单元格区域，即找到的行。其中用了两个知识点，第一是offset偏移，第二是resize单元格区域重置
如果不是什么都没有，就把开始已经赋值的单元格区域和现在找到的单元格区域做并集，即联合起来。这样解释应该清楚了吧。

zhangjianiam

用你修改后的的代码提取花名册，所在年级本应在N列，却出现在R列。麻烦您再帮忙看看哈。