VBA Excel 中的多线程
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/19159025/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Multithreading in VBA Excel
提问by Valdemar Z
How can I write code in VBA to get multi-threaded parsing?
如何在 VBA 中编写代码以获得多线程解析？
I've looked at this tutorial, but it is not working.
我看过这个教程，但它不起作用。
I have 10000 sites, each site in one row in column A. I need at least 10 concurrent threads to parse info between tags <div></div>, take tag <a>with rel="external"from index.php on each site, then save the results to each row in column B.
我有 10000 个站点，每个站点在 A 列的一行中。我需要至少 10 个并发线程来解析标签之间的信息，从每个站点上的 index.php<div></div>获取标签，然后将结果保存到 B 列中的每一行。<a>rel="external"
回答by Aaron Thomas
As @Siddharth Rout points out in his comment, the answer is no. But to expand on this a little, even methods that would seem to run in the background and enable multi-threading like abilities do not allow multithreading.
正如@Siddharth Rout 在评论中指出的那样，答案是否定的。但是稍微扩展一下，即使是似乎在后台运行并启用多线程功能的方法也不允许多线程。
A great example of this is Application.OnTime. It allows a procedure to be run at a point in the future.
一个很好的例子是Application.OnTime。它允许程序在未来的某个时间点运行。
This method allows the user to continue editing the workbook until the preset amount of time has elapsed and the procedure is called. At first glance, it might seem possible that clever use of this would enable multiple code fragments to run simultaneously. Consider the following fragment:
此方法允许用户继续编辑工作簿，直到经过预设的时间量并调用该过程。乍一看，巧妙地使用它似乎有可能使多个代码片段同时运行。考虑以下片段：
For a = 1 To 500000000
Next a
The For...Next loop on my machine takes about 5 seconds to complete. Now consider this:
我机器上的 For...Next 循环大约需要 5 秒才能完成。现在考虑这个：
Application.OnTime Now + TimeValue("00:00:1"), "ztest2"
For a = 1 To 500000000
Next a
This calls "ztest2" one second after the Application.OnTime statement is read. It's conceivable that, since the For...Next loop takes 5 seconds and .OnTime will execute after 1 second, perhaps "ztest2" will be called in the midst of the For...Next loop, i.e., psuedo-multithreading.
这会在 Application.OnTime 语句被读取后一秒调用“ztest2”。可以想象，由于 For...Next 循环需要 5 秒并且 .OnTime 将在 1 秒后执行，因此可能会在 For...Next 循环中间调用“ztest2”，即伪多线程。
Well, this does not happen. As running the above code will show, Application.OnTime must wait patiently until the For...Next loop is done.
嗯，这不会发生。运行上面的代码将显示，Application.OnTime 必须耐心等待直到 For...Next 循环完成。
回答by AnalystCave.com
You can use multithreading in VBA but NOT natively.There are however several possibilities to achieve multithreading in VBA:
您可以在 VBA 中使用多线程，但不能在本机中使用。然而，在 VBA 中实现多线程有几种可能性：
- C#.NET COM/dlls- create a COM/dll in C#.NET which allows you to freely create threads and reference it from VBA like other external libraries. See my post on this: here. See also this Stackoverflow post on referencing C# methods from within VBA: Using a C# dll inside EXCEL VBA
- VBscript worker threads- partition your algorithm into as many VBscripts as you need threads and execute them from VBA. The VBscripts can be created automatically via VBA. See my post on this: here
- VBA worker threads- copy your Excel workbook as many times as you need threads and execute them via VBscript from VBA. The VBscripts can be created automatically via VBA. See my post on this: here
- C#.NET COM/dlls- 在 C#.NET 中创建一个 COM/dll，它允许您像其他外部库一样自由地创建线程并从 VBA 引用它。请参阅我的帖子：here。另请参阅有关从 VBA 中引用 C# 方法的 Stackoverflow 帖子：Using a C# dll inside EXCEL VBA
- VBscript 工作线程- 根据需要将您的算法划分为尽可能多的 VBscript，并从 VBA 执行它们。VBscripts 可以通过 VBA 自动创建。请参阅我的帖子：这里
- VBA 工作线程- 根据需要多次复制 Excel 工作簿，并通过 VBA 中的 VBscript 执行它们。VBscripts 可以通过 VBA 自动创建。请参阅我的帖子：这里
I analyzed all these approaches and made a comparison of the pro's and con's and some performance metrics. You can find the whole post here:
我分析了所有这些方法，并对优点和缺点以及一些性能指标进行了比较。你可以在这里找到整篇文章：
http://analystcave.com/excel-multithreading-vba-vs-vbscript-vs-c-net/
http://analystcave.com/excel-multithreading-vba-vs-vbscript-vs-c-net/
回答by TakenItEasy
While you can't do true multi-threading i.e. run threads simultaneously in parallel on different cores, you can simulate multi-threaded code by queueing up actions from multiple threads.
虽然您无法实现真正的多线程，即在不同的内核上同时并行运行线程，但您可以通过对来自多个线程的操作进行排队来模拟多线程代码。
Example: Run subA once every 600 ms(milliseconds) and SubB once every 200 ms such that the order would be: SubB,SubB,SubB,SubA,SubB,SubB,SubB,SubA,SubB,SubB,...
示例：每 600 毫秒（毫秒）运行一次 subA，每 200 毫秒运行一次 SubB，因此顺序为：SubB,SubB,SubB,SubA,SubB,SubB,SubB,SubA,SubB,SubB,...
'Create a new class Tick_Timer to get access to NumTicks which counts ticks in
'milliseconds.
'While not used for this script, this class can also be used for a millisecond
'StartTimer/EndTimer which I included below.
'It can also be used to create a pause, similar to wait but in ms, that can
'allow other code to run while paused which I prefer over the sleep function.
'Sleep doesn't allow interruptions and hogs processor time.
'The pause function would be placed in a module and works similar to the
'Queue Timer loop which I'll explain below.
Private StartTick As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Public Function GetNumTicks() As Long
GetNumTicks = GetTickCount
End Function
'Timer functions(not used in this script)
Public Sub StartTimer()
StartTick = GetTickCount
End Sub
Public Function EndTimer() As Long
EndTimer = (GetTickCount - StartTick)
End Function
In a module I declared some global variables. While I'm aware many consider use of global variables s as bad practice. I always use a prefix for globals so they don't cause confusion with local variables.
在一个模块中，我声明了一些全局变量。虽然我知道很多人认为使用全局变量是不好的做法。我总是为全局变量使用前缀，这样它们就不会与局部变量混淆。
In this case, I global variables have advantages over using arguments since new threads may be called at any time that may need to execute before the first timer in the queue.
在这种情况下，I 全局变量比使用参数更有优势，因为新线程可能会在任何时间被调用，这可能需要在队列中的第一个计时器之前执行。
Global variables can be changed anywhere so that updating the queue can be done dynamically. Also consider that nearly every subroutine uses the queue in some way so just make more sense to use globals.
全局变量可以在任何地方更改，以便可以动态地更新队列。还要考虑到几乎每个子程序都以某种方式使用队列，所以使用全局变量更有意义。
Public ST_TimerName As String 'Subroutine Name that is run as a new thread.
'Two strings are used to store the queue.
'The first stores only the start times of each thread in tickcounts.
'This allows me to sort the queue more easily.
'The second string (ST_TimerQ) contains TimerDelay:TimerName and is created at the
'same time as the sorted launch times so they are kept synchronous.
Public ST_EndTickQ As String 'queue string: trigger times in TickCounts.
Public ST_TimerQ As String 'queue string: TimerDelay:TimerName
'New class that allows you to get the current Tick Count.
Public ST_Timer As Tick_Timer 'timer that accesses to Tick Count
Sub SetTimer(ByVal TimerName As String, ByVal TimerDelay As Long)
'Starts a new thread called TimerName which executes after TimerDelay(ms)
'TimerName: Name of subroutine that is to be activated.
'TimerDelay:
'-value for single execution after abs(-value) delay,
'+value Repeats TimerName with a period of TimerDelay.
'0 stops repeating TimerName.
Dim EndTick As Long
Dim TimerDat As String
Set ST_Timer = New Tick_Timer
EndTick = ST_Timer.GetNumTicks + Abs(TimerDelay)
If TimerDelay = 0 Then
'Stops TimerName
RemoveFromQ TimerName
Else
'Insert to Queue, single or repeated is determined by +/-delay stored in TimerDat.
TimerDat = TimerDelay & ":" & TimerName
Call AddToQ(TimerDat, EndTick)
End If
End Sub 'SetTimer
Sub SetTimerQLoop()
'All threads are continuously merged into an action queue with a sequential
'insertion sort.
'A simple loop containing only the DoEvents function(allows other VBA code to run)
'loops until the the next thread in the queue needs to start.
'An outer loop runs through the queue until EOQ.
Dim EndTick As Long
Dim EOQ As Boolean
On Error GoTo ErrHandler
EOQ = False
'SetTimer Queue Loop
Do While Not (EOQ)
'Delay Loop, DoEvents allows other vba scripts to run during delay.
Do
DoEvents
Loop Until ST_Timer.GetNumTicks >= Val(ST_EndTickQ)
Application.Run ST_TimerName
If Val(ST_TimerQ) > 0 Then
'Reinsert into queue threads with pos delay value.
EndTick = Val(ST_EndTickQ) + Val(ST_TimerQ)
TimerDat = Val(ST_TimerQ) & ":" & ST_TimerName
Call AddToQ(TimerDat, EndTick)
End If
If ST_TimerQ = vbNullString Then
EOQ = True
Else
GetNextQ
End If
Loop
Exit Sub
ErrHandler:
'Break Key
End Sub 'SetTimerQLoop
Sub AddToQ(ByVal TimerDat As String, ByVal EndTick As Long)
Dim EndTickArray() As String
Dim TimerArray() As String
Dim LastTickIndex As Integer
Dim LastTimerIndex As Integer
Dim PosDatDel As Integer
Dim TimerDelay As Long
Dim TimerName As String
Dim QFirstTick As Long
Dim QLastTick As Long
PosDatDel = Len(TimerDat) - InStr(TimerDat, ":")
TimerDelay = Val(TimerDat)
TimerName = Right(TimerDat, PosDatDel)
If ST_EndTickQ = vbNullString Then
'First timer
ST_TimerName = TimerName
ST_EndTickQ = EndTick
ST_TimerQ = TimerDat
SetTimerQLoop
ElseIf InStr(ST_EndTickQ, "|") = 0 Then
'Second timer
If EndTick < Val(ST_EndTickQ) Then
'New timer is first of 2 in Q
ST_TimerName = TimerName
ST_EndTickQ = EndTick & "|" & ST_EndTickQ
ST_TimerQ = TimerDat & "|" & ST_TimerQ
Else
'New timer is 2nd of 2 in Q
ST_TimerName = TimerNameF(ST_TimerQ)
ST_EndTickQ = ST_EndTickQ & "|" & EndTick
ST_TimerQ = ST_TimerQ & "|" & TimerDat
End If
Else
'3rd+ timer: split queue into an array to find new timers position in queue.
TimerArray = Split(ST_TimerQ, "|")
LastTimerIndex = UBound(TimerArray)
EndTickArray = Split(ST_EndTickQ, "|")
LastTickIndex = UBound(EndTickArray)
ReDim Preserve EndTickArray(LastTickIndex)
ReDim Preserve TimerArray(LastTimerIndex)
QFirstTick = Val(ST_EndTickQ)
QLastTick = Val(EndTickArray(LastTickIndex))
If EndTick < QFirstTick Then
'Front of queue
ST_EndTickQ = EndTick & "|" & ST_EndTickQ
ST_TimerQ = TimerDat & "|" & ST_TimerQ
ST_TimerName = Val(ST_TimerQ)
ElseIf EndTick > QLastTick Then
'Back of queue
ST_TimerName = TimerNameF(ST_TimerQ)
ST_EndTickQ = ST_EndTickQ & "|" & EndTick
ST_TimerQ = ST_TimerQ & "|" & TimerDat
Else
'Somewhere mid queue
For i = 1 To LastTimerIndex
If EndTick < EndTickArray(i) Then
ST_EndTickQ = Replace(ST_EndTickQ, EndTickArray(i - 1), _
EndTickArray(i - 1) & "|" & EndTick)
ST_TimerQ = Replace(ST_TimerQ, TimerArray(i - 1), _
TimerArray(i - 1) & "|" & TimerDat)
Exit For
End If
Next i
ST_TimerName = TimerNameF(ST_TimerQ)
End If
End If
End Sub 'AddToQ
Sub RemoveFromQ(ByVal TimerName As String)
Dim EndTickArray() As String
Dim TimerArray() As String
Dim LastTickIndex As Integer
Dim LastTimerIndex As Integer
Dim PosDel As Integer
PosDel = InStr(ST_EndTickQ, "|")
If PosDel = 0 Then
'Last element remaining in queue
ST_EndTickQ = vbNullString
ST_TimerQ = vbNullString
ST_TimerName = vbNullString
Else
'2+ elements in queue
TimerArray = Split(ST_TimerQ, "|")
LastTimerIndex = UBound(TimerArray)
EndTickArray = Split(ST_EndTickQ, "|")
LastTickIndex = UBound(EndTickArray)
ReDim Preserve EndTickArray(LastTickIndex)
ReDim Preserve TimerArray(LastTimerIndex)
ST_TimerQ = vbNullString
ST_EndTickQ = vbNullString
For i = 0 To LastTimerIndex
If InStr(TimerArray(i), TimerName) = 0 Then
If ST_TimerQ = vbNullString Then
ST_TimerQ = TimerArray(i)
ST_EndTickQ = EndTickArray(i)
X = Len(ST_TimerQ) - InStr(ST_TimerQ, ":")
ST_TimerName = Right(ST_TimerQ, X)
Else
ST_TimerQ = ST_TimerQ & "|" & TimerArray(i)
ST_EndTickQ = ST_EndTickQ & "|" & EndTickArray(i)
End If
End If
Next i
End If
End Sub 'RemoveFromQ
Sub GetNextQ()
Dim PosDel As Integer
PosDel = InStr(ST_EndTickQ, "|")
If PosDel = 0 Then
'Last element remaining in queue
ST_EndTickQ = vbNullString
ST_TimerQ = vbNullString
ST_TimerName = vbNullString
Else
'2+ elements in queue
ST_EndTickQ = Right(ST_EndTickQ, Len(ST_EndTickQ) - PosDel)
ST_TimerQ = Right(ST_TimerQ, Len(ST_TimerQ) - InStr(ST_TimerQ, "|"))
ST_TimerName = TimerNameF(ST_TimerQ)
End If
End Sub 'GetNextQ
Public Function TimerNameF(ByVal TimerQ As String) As String
Dim StrLen As Integer
If InStr(ST_TimerQ, "|") Then
StrLen = InStr(ST_TimerQ, "|") - InStr(ST_TimerQ, ":") - 1
Else
StrLen = Len(ST_TimerQ) - InStr(ST_TimerQ, ":")
End If
TimerNameF = Mid(ST_TimerQ, InStr(ST_TimerQ, ":") + 1, StrLen)
End Function
Sub TestSetTimer1()
'Call SubA every 5 seconds
Call SetTimer("SubA", 600)
End Sub
Sub TestSetTimer2()
'Call SubB every second
Call SetTimer("SubB", 200)
End Sub
Sub TestSetTimer3()
'Stop calling SubA
Call SetTimer("SubA", 0)
End Sub
Sub TestSetTimer4()
'Stop calling SubB
Call SetTimer("SubB", 0)
End Sub
Sub TestSetTimer5()
'Call SubC one time after a 3 second delay.
Call SetTimer("SubC", -3000)
End Sub
Sub SubA()
Debug.Print "SubA Queue: " & ST_TimerQ & ", EndTickQ: " & ST_EndTickQ
End Sub
Sub SubB()
Debug.Print "SubB Queue: " & ST_TimerQ & ", EndTickQ: " & ST_EndTickQ
End Sub
Sub SubC()
Debug.Print "SubC Queue: " & ST_TimerQ & ", EndTickQ: " & ST_EndTickQ
End Sub
I'm not an expert coder so I'm sure others can do better but it runs fairly well as written. The bulk of the code just manages the queue which can probably be done more efficiently.
我不是专家编码员，所以我相信其他人可以做得更好，但它运行得相当好。大部分代码只是管理队列，这可能会更有效地完成。
Besides SetTimer, You can also create threads that trigger on a schedule, with a mouse or keyboard event, or even for screen scrapping pixels in your active window.
除了 SetTimer 之外，您还可以创建按计划触发的线程，使用鼠标或键盘事件，甚至是活动窗口中的屏幕抓取像素。
Threads are useful when you can't know when to activate code at design time. For example:
当您在设计时不知道何时激活代码时，线程很有用。例如：
You create a poker HUD+DB for on-line tournament poker. One thread could run every couple hundred ms waiting for triggers such as when a new hand begins you read the last HH and update the database and hud, or a new player joins the table and it does an automatic look up on a tournament tracking site. Another thread may run every second to update a tournament clock displayed on your hud and provide a 3 min warning before level changes and so on.
您为在线锦标赛扑克创建了一个扑克 HUD+DB。一个线程可以每几百毫秒运行一次以等待触发器，例如当新手牌开始时您读取最后一个 HH 并更新数据库和 hud，或者一个新玩家加入表并在锦标赛跟踪站点上自动查找。另一个线程可能会每秒运行一次以更新显示在您的 hud 上的锦标赛时钟，并在级别更改之前提供 3 分钟警告等等。
You can even create a seperate shell script to run a thread that automatically joins new tournaments you scheduled for in advance and it can then launch a new copy of your script for each table your playing. I'm not certain if launching multiple copies of scripts or running scripts from different projects can then truly multi-thread using VBA but I kind of doubt it based on what I've seen in the forums.
您甚至可以创建一个单独的 shell 脚本来运行一个线程，该线程自动加入您预先安排的新锦标赛，然后它可以为您玩的每张桌子启动脚本的新副本。我不确定启动多个脚本副本或运行来自不同项目的脚本是否可以使用 VBA 实现真正的多线程，但根据我在论坛中看到的内容，我有点怀疑。
Note, while it was running bug free, I made some changes to clean it up a bit and introduced some minor bugs I never got a chance to fix.
请注意，虽然它没有错误运行，但我做了一些更改以对其进行清理并引入了一些我从未有机会修复的小错误。
