Application.Ontime只能实现秒级定时，毫秒级定时器需要调用API函数。
例：A1单元格每10毫秒随机出现1-100，VBA代码：
#If Win64 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
#Else
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
#End If
'64位操作系统API函数声明与X86操作系统API函数声明。
'声明TimerID用于存放定时器的ID。
Public TimerID As Long
'启动定时器。Duration是定时器触发的时间，单位为毫秒。
Sub StartTimer(ByVal Duration As Long)
If TimerID = 0 Then
TimerID = SetTimer(0, 0, Duration, AddressOf OnTimer)
Else
Call StopTimer
TimerID = SetTimer(0, 0, Duration, AddressOf OnTimer)
End If
End Sub
'停止定时器。
Sub StopTimer()
KillTimer 0, TimerID
End Sub
'必须忽视错误，否则会弹出错误提示。
Sub OnTimer()
On Error GoTo line
Call StartTimer(10)
Cells(1, 1).Value = Int(100 * Rnd) + 1
line:
End Sub
效果演示图：
开始按钮链接OnTimer,暂停按钮链接 StopTimer

在这个基础上，制作一个简易的抽签小程序。
例：不重复抽取1-10号，效果图：
VBA代码：
#If Win64 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
#Else
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
#End If
Public TimerID As Long
Public temp As Variant
Public iCount As Long
Public FilterVal As Long
Public flag As Boolean
Sub InitTimer(ByVal Duration As Long)
If TimerID = 0 Then
TimerID = SetTimer(0, 0, Duration, AddressOf OnTime)
Else
Call StopTimer
TimerID = SetTimer(0, 0, Duration, AddressOf OnTime)
End If
End Sub
Sub StopTimer()
KillTimer 0, TimerID
End Sub
Sub OnTime()
On Error GoTo line
Cells(1, 1).Value = temp((UBound(temp) + 1) * Rnd)
line:
End Sub
Sub StartTimer()
flag = True
Call Proce
Call InitTimer(50)
End Sub
Sub PauseTimer()
If iCount >= 11 Then Exit Sub
Call StopTimer
If flag = True Then
iCount = iCount + 1
FilterVal = Cells(1, 1).Value
If iCount <= 10 Then
MsgBox Prompt:="抽签结果为" & Cells(1, 1).Value & Chr(10) & "剩余签数" & 10 - iCount, Title:="抽签程序"
Else
MsgBox Prompt:="抽签完毕", Title:="抽签程序"
End If
flag = False
End If
End Sub
Sub Clear()
Call StopTimer
flag = False
Cells(1, 1).Value = ""
iCount = 0
FilterVal = 0
Erase temp
End Sub
Sub Proce()
Dim arr(0 To 9), i As Long
If iCount > 0 Then
temp = Filter(temp, FilterVal, False)
Else
For i = 0 To 9
arr(i) = i + 1
Next
temp = arr
End If
End Sub

不需要这样写啊，你直接写个死循环就可以了
do
doevents
xx
loop
而且你用这settimer函数很容易会崩的

您好，想私信请教问题