Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 3268|回复: 9

[已解决]多条件查找复制学生信息,恳请提速。

[复制链接]
发表于 2013-5-5 18:43 | 显示全部楼层 |阅读模式
本帖最后由 cyt-hk 于 2013-5-5 20:30 编辑

http://www.excelpx.com/forum.php?mod=attachment&aid=MjcyMjk3fGEyZDcyMTRiNjRhYzI3NGY0MGMzNDhhMjUxMzcxNGJjfDE3MTE3MjEwMzc%3D&request=yes&_f=.rar运行速度太慢,请老师帮忙提速。

附件: 学生统计.rar (368.75 KB, 下载次数: 23)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2013-5-5 19:13 | 显示全部楼层
回复

使用道具 举报

发表于 2013-5-5 21:22 | 显示全部楼层
sh = Sheet16.Range("B65536").End(xlUp).Row
Sheet16.Range("B6" & ":L" & sh).ClearContents

这有个漏洞,第一次清空表的时候,再运一行次,就把表头也给清掉了。
你得做下判断行号是否大于5,只在大于5时才能执行CLEARCONTENTS。
另外因为你用了合并单元各,最好用G65536或H65535来做END。

第一次没有找到三类学生,数据就清完了,第二次再运行,连标题行也给清没了,报错就是这么来的。

回复

使用道具 举报

发表于 2013-5-5 21:23 | 显示全部楼层
另外,数据遍历最好用数组的方式,你直接读取单元格,效率很低。
回复

使用道具 举报

发表于 2013-5-5 21:24 | 显示全部楼层
也不知道你的判断标准是否对不对,这么多数据判断下来,居然汉有一个合乎条件的。
回复

使用道具 举报

 楼主| 发表于 2013-5-6 10:51 | 显示全部楼层
初学vba,数组与字典不懂使用。请抽空帮忙。谢谢!
回复

使用道具 举报

 楼主| 发表于 2013-5-6 16:28 | 显示全部楼层
运行速度太慢,请老师帮忙提速。
回复

使用道具 举报

发表于 2013-5-7 14:57 | 显示全部楼层
  1. Sub 提取信息()
  2.     Dim t#
  3.     t = Timer
  4.     Application.ScreenUpdating = False

  5.     Dim i, sh, num1, k
  6.     a = MsgBox("将删除所有学生信息," & vbCrLf & "按“是”继续执行," & vbCrLf & "按“否”则退出。", 308, "提示")
  7.     If a = vbNo Then Exit Sub

  8.     With Sheet16
  9.         sh = .Cells(Rows.Count, "b").End(xlUp).Row
  10.         If sh > 5 Then .Range("B6" & ":L" & sh).ClearContents
  11.     End With

  12.     num1 = Sheet1.Range("C65536").End(xlUp).Row()
  13.     If num1 < 7 Then Exit Sub
  14.     arr = Sheet1.Range("a7:ai" & num1)
  15.     Dim result(), lCount&
  16.     ReDim result(1 To UBound(arr), 1 To 12)

  17.     For i = LBound(arr) To UBound(arr)

  18.         If arr(i, 35) >= 1 And arr(i, 35) < 4 And arr(i, 30) >= 6 And arr(i, 30) < 16 Then
  19.             lCount = lCount + 1
  20.             result(lCount, 2) = arr(i, 3)
  21.             result(lCount, 3) = arr(i, 4)
  22.             result(lCount, 4) = arr(i, 5)
  23.             result(lCount, 5) = arr(i, 6)
  24.             result(lCount, 6) = arr(i, 7)
  25.             result(lCount, 9) = arr(i, 28)
  26.             result(lCount, 12) = arr(i, 30)

  27.         End If
  28.     Next i

  29.     With Sheet16
  30.         If lCount > 0 Then
  31.             .Range("a6").Resize(lCount, UBound(result, 2)) = result
  32.             .Range("D6:D" & 5 + lCount).NumberFormatLocal = "yy-mm"
  33.             .Range("B6" & ":L" & 5 + lCount).Sort Key1:=.Range("L6")
  34.         Else
  35.             MsgBox "没有三类残学生信息。", 308, "提示"
  36.         End If
  37.     End With
  38.         Application.ScreenUpdating = True
  39.         MsgBox Timer - t
  40.     End Sub
复制代码
回复

使用道具 举报

发表于 2013-5-7 14:57 | 显示全部楼层
改成数组了,你试试吧。
回复

使用道具 举报

发表于 2013-5-7 15:02 | 显示全部楼层    本楼为最佳答案   
  1. Sub 提取信息()
  2.     Dim t#

  3.     '如果只是在03有,LONG可以换成INTEGER
  4.     Dim i As Long, sh As Long

  5.     t = Timer
  6.     Application.ScreenUpdating = False

  7.     If MsgBox("将删除所有学生信息," & vbCrLf & "按“是”继续执行," & vbCrLf & "按“否”则退出。", 308, "提示") = vbNo Then Exit Sub

  8.     With Sheet16
  9.         sh = .Cells(Rows.Count, "b").End(xlUp).Row
  10.         If sh > 5 Then .Range("B6" & ":L" & sh).ClearContents
  11.     End With

  12.     sh = Sheet1.Range("C65536").End(xlUp).Row()
  13.     If sh < 7 Then Exit Sub
  14.     arr = Sheet1.Range("a7:ai" & sh)

  15.     Dim result(), lCount&

  16.     ReDim result(1 To UBound(arr), 1 To 12)

  17.     For i = LBound(arr) To UBound(arr)
  18.         If arr(i, 35) >= 1 And arr(i, 35) < 4 And arr(i, 30) >= 6 And arr(i, 30) < 16 Then
  19.             lCount = lCount + 1
  20.             result(lCount, 2) = arr(i, 3)
  21.             result(lCount, 3) = arr(i, 4)
  22.             result(lCount, 4) = arr(i, 5)
  23.             result(lCount, 5) = arr(i, 6)
  24.             result(lCount, 6) = arr(i, 7)
  25.             result(lCount, 9) = arr(i, 28)
  26.             result(lCount, 12) = arr(i, 30)
  27.         End If
  28.     Next i

  29.     With Sheet16
  30.         If lCount > 0 Then
  31.             .Range("a6").Resize(lCount, UBound(result, 2)) = result
  32.             .Range("D6:D" & 5 + lCount).NumberFormatLocal = "yy-mm"
  33.             .Range("B6" & ":L" & 5 + lCount).Sort Key1:=.Range("L6")
  34.         Else
  35.             MsgBox "没有三类残学生信息。", 308, "提示"
  36.         End If
  37.     End With
  38.    
  39.     Application.ScreenUpdating = True
  40.     MsgBox Timer - t
  41. End Sub
复制代码
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 22:03 , Processed in 6.207362 second(s), 13 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表