ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 1738|回复: 12

[求助] 一段简单的代码运行需要5-6分钟,麻烦大虾们看一下问题出在哪里?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-6-6 10:42 | 显示全部楼层 |阅读模式
本帖最后由 123080464 于 2020-6-6 11:22 编辑

代码运行完成需5-6分钟,CPU占用50%左右,电脑是新的。

工资附加费表.zip

708.11 KB, 下载次数: 19

TA的精华主题

TA的得分主题

发表于 2020-6-6 11:14 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
用数组,判断的结果也放数组里面最后一次处理。
For i = 3 To 10000
If ThisWorkbook.Sheets("数据源").Cells(i, 1) = "" Then Exit For
If ThisWorkbook.Sheets("数据源").Cells(i, 1) <> Cells(y, 4) Then
   Cells(y + 1, 4) = ThisWorkbook.Sheets("数据源").Cells(i, 1)
   y = y + 1
End If
这可以俩数组,判断第一个数组,改第二个对应数组,最后用第二个数组赋值。
For x = hs To 2 Step -1
If Cells(x, 7) = 0 Then Rows(x).Delete
If Application.WorksheetFunction.CountIf(Range("K1:W1"), Cells(x, 3)) = 0 Then Rows(x).Delete
Next
这也是一样

TA的精华主题

TA的得分主题

发表于 2020-6-6 11:26 | 显示全部楼层
For x = hs To 2 Step -1
If Cells(x, 7) = 0 Then Rows(x).Delete
If Application.WorksheetFunction.CountIf(Range("K1:W1"), Cells(x, 3)) = 0 Then Rows(x).Delete
Next
问题在这个循环内,大量的逐行删除工作,所以会很慢,5~6分钟貌似不奇怪了。

如果要提升速度,可以考虑将数据写入数组内,进行整理后重新写出,应该几秒就能完成吧。

TA的精华主题

TA的得分主题

发表于 2020-6-6 11:33 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-6-6 11:37 | 显示全部楼层
代码慢的原因是反复读写单元格,使用数组比较数据+Union合并所有需要删除的行,最后一笔删除

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-6-6 12:54 | 显示全部楼层
suibianbei~ 发表于 2020-6-6 11:26
For x = hs To 2 Step -1
If Cells(x, 7) = 0 Then Rows(x).Delete
If Application.WorksheetFunction. ...

能给写一下代码吗?

TA的精华主题

TA的得分主题

发表于 2020-6-6 13:26 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
123080464 发表于 2020-6-6 12:54
能给写一下代码吗?

你得先说明白你的需求,别拿代码让别人读

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-6-6 13:44 | 显示全部楼层
123080464 发表于 2020-6-6 12:54
能给写一下代码吗?

需求很简单,把G列为0的删除,把C列不包含在K1:W1的删除

TA的精华主题

TA的得分主题

发表于 2020-6-6 14:21 | 显示全部楼层
本帖最后由 sheffield 于 2020-6-6 16:01 编辑

删除行的办法消耗太大,而且损害了"数据来源",不如直接从"数据来源"中检索出需要的数据。
建议直接从科目名称入手,而非科目代码,不然容易出错。
直接运行如下代码(附件中的模块3),在我的电脑上秒出结果,你检查对不对:
  1. Sub main()
  2.     Dim sp As New ExcelSpice, criteria As String
  3.     '连接数据来源:
  4.     sp.Link ThisWorkbook.Sheets("数据来源")
  5.     '构造筛选条件:
  6.     criteria = "(科目名称 like 其他应付款\-代扣代缴\*"
  7.     criteria = criteria & "; 科目名称 like 应付职工薪酬\-社会保险费\*"
  8.     criteria = criteria & "; 科目名称 = 应付职工薪酬\-其他保险费\-补充养老保险\(年金\)"
  9.     criteria = criteria & "; 科目名称 = 应付职工薪酬\-职工福利\-其他"
  10.     criteria = criteria & "; 科目名称 = 应付职工薪酬\-工会经费)"
  11.     criteria = criteria & ", 本期贷方 <> 0"
复制代码


工资附加费表.rar

964.84 KB, 下载次数: 15

其中的类模块不需要改动,具体看我的主贴分享,或者www.excelspice.com

TA的精华主题

TA的得分主题

发表于 2020-6-6 16:02 | 显示全部楼层
本帖最后由 suibianbei~ 于 2020-6-6 16:05 编辑

再尽量不改变原来思路的情况下,用数组实现。楼主可以试试。
如果想覆盖当前的话,可以用clear清空,然后写到当前工作表。当然,用query实现也可以,修改起来更方便。

科目.zip

657.97 KB, 下载次数: 8

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

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-28 23:20 , Processed in 0.053107 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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