ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] 求不假死又不占CPU的延迟函数?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-8-5 20:30 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 ivrdachen 于 2018-8-5 23:35 编辑

Sub delay(t As Single)
     Dim time1, time2 As Single
     time1 = Timer
     Do
         DoEvents
         time2 = Timer - time1
         If time2 < 0 Then time2 = time2 + 86400     '86400=24*3600 单位为秒
     Loop While time2 < t
End Sub

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub delay(t)  't 为秒
Sleep t * 1000
End Sub

第一个占CPU太高了,CPU直接100%了,第二个不占CPU,但excel假死


两个结合一下,解决了这个问题,
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub delay(t As Single)
     Dim time1, time2 As Single
     time1 = Timer
     Do
         DoEvents
         Sleep 10 '延迟10ms
         time2 = Timer - time1
         If time2 < 0 Then time2 = time2 + 86400     '86400=24*3600 单位为秒
     Loop While time2 < t
End Sub

TA的精华主题

TA的得分主题

发表于 2018-8-5 20:53 | 显示全部楼层
'关闭excel时先执行endtimer(判断flag的值),或把endtimer放在workbook的退出事件里执行

'不够稳定,有时会闪退。自己可以试一下。建立一个新工作簿,,,。

Option Explicit

Public Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
Public TimerID As Long
Public TimerSeconds As Single
Public flag As Boolean

Sub test()
  If flag Then
    EndTimer
  Else
    StartTimer
  End If
  flag = Not flag
End Sub

Sub StartTimer()
    TimerSeconds = 1
    TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub
Sub EndTimer()
    On Error Resume Next
    KillTimer 0&, TimerID
End Sub
Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
    Debug.Print Timer, flag
End Sub

TA的精华主题

TA的得分主题

发表于 2018-8-5 21:41 | 显示全部楼层

直接用第二个sleep函数,EXCEL不可能假死,只要加一加:DoEvents

把Sleep t * 1000改为:Sleep t * 1000:DoEvents

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-8-5 23:36 | 显示全部楼层
ivccav 发表于 2018-8-5 21:41
直接用第二个sleep函数,EXCEL不可能假死,只要加一加:DoEvents

把Sleep t * 1000改为:Sleep t * 100 ...

不过这个sleep延迟貌似不太准确
两个结合一下,解决了这个问题,CPU占用比较少,延迟也很准
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub delay(t As Single)
     Dim time1, time2 As Single
     time1 = Timer
     Do
         DoEvents
         Sleep 10 '延迟10ms
         time2 = Timer - time1
         If time2 < 0 Then time2 = time2 + 86400     '86400=24*3600 单位为秒
     Loop While time2 < t
End Sub

TA的精华主题

TA的得分主题

发表于 2018-8-6 09:30 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
  1. Public Sub YanChi(ByVal num As Double)
  2.     rem 暂停一下,num=1:就是1秒
  3.     Dim t
  4.     t = Timer
  5.     Do While Timer - num < t
  6.          DoEvents
  7.     Loop
  8. End Sub
复制代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2025-1-11 17:06 , Processed in 0.032421 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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