VBA 中的多线程

这里有人知道如何让 VBA 运行多个线程吗? 我正在使用 Excel。

129700 次浏览
小开
最佳答案

不能用 VBA 本地完成。VBA 是在单线程公寓中构建的。获得多个线程的唯一方法是在具有 COM 接口的 VBA 之外的其他内容中构建 DLL，并从 VBA 调用它。

信息: OLE 线程模型的描述和工作

小开

我正在寻找类似的东西，官方的答案是否定的。然而，我在 ExcelHero.com 上找到了 Daniel 的一个有趣的概念。

基本上，您需要创建 worker vbscript 来执行您想要的各种事情，并让它报告给 excel。对于我所做的，从各种网站检索 HTML 数据，它工程伟大！

看看吧:

Http://www.excelhero.com/blog/2010/05/multi-threaded-vba.html

小开

正如您可能了解到的，VBA 本身并不支持多线程，但是，有3种方法可以实现多线程:

  1. COM/dlls -例如 C # 和在不同线程中运行的并行类
  2. 使用 VBscript 工作线程 -在单独的 VBscript 线程中运行您的 VBA 代码
  3. 使用 VBA 工作线程执行，例如通过 VBscript -复制 Excel 工作簿并并行运行宏。

我在这里比较了所有的线程方法: http://analystcave.com/excel-multithreading-vba-vs-vbscript-vs-c-net/

考虑到方法 # 3，我还开发了一个 VBA 多线程工具，它允许您轻松地向 VBA: http://analystcave.com/excel-vba-multithreading-tool/添加多线程

请看下面的例子:

多线程 For 循环

Sub RunForVBA(workbookName As String, seqFrom As Long, seqTo As Long)
For i = seqFrom To seqTo
x = seqFrom / seqTo
Next i
End Sub


Sub RunForVBAMultiThread()
Dim parallelClass As Parallel


Set parallelClass = New Parallel


parallelClass.SetThreads 4


Call parallelClass.ParallelFor("RunForVBA", 1, 1000)
End Sub

异步运行 Excel 宏

Sub RunAsyncVBA(workbookName As String, seqFrom As Long, seqTo As Long)
For i = seqFrom To seqTo
x = seqFrom / seqTo
Next i
End Sub


Sub RunForVBAAndWait()
Dim parallelClass As Parallel


Set parallelClass  = New Parallel


Call parallelClass.ParallelAsyncInvoke("RunAsyncVBA", ActiveWorkbook.Name, 1, 1000)
'Do other operations here
'....


parallelClass.AsyncThreadJoin
End Sub
小开

我添加这个答案是因为程序员从更现代的语言来到 VBA，在 VBA 中搜索 Stack Overflow 寻找多线程，可能没有意识到一些原生的 VBA 方法，这些方法有时有助于弥补 VBA 缺乏真正的多线程。

如果多线程的动机是为了拥有一个响应性更强的 UI，在执行长时间运行的代码时不会挂起，那么 VBA 确实有一些低技术含量的解决方案，这些解决方案经常在实践中起作用:

1)用户表单可以非模态显示——这允许用户在打开表单时与 Excel 交互。这可以在运行时通过将 Userform 的 ShowModal 属性设置为 false 来指定，也可以通过放置代码行动态地作为 from 加载来完成

UserForm1.Show vbModeless

在用户窗体的初始化事件中。

2) DoEvents 语句。这导致 VBA 将控制权交给操作系统来执行事件队列中的任何事件——包括由 Excel 生成的事件。典型的用例是在代码执行时更新图表。没有 DoEvents，直到宏运行之后才会重新绘制图表，但是使用 DoEvents，您可以创建动画图表。这种想法的一个变体是创建进度表的常见技巧。在一个执行10,000,000次(并由循环索引 我控制)的循环中，你可以有一段代码，比如:

If i Mod 10000 = 0 Then
UpdateProgressBar(i) 'code to update progress bar display
DoEvents
End If

所有这些都不是多线程——但是在某些情况下它可能是一个足够的组装件。

小开

我知道这个问题指定了 Excel，但是因为同一个 Access 问题被标记为重复，所以我将在这里发布我的答案。 原理很简单: 打开一个新的 Access 应用程序，然后打开一个包含计时器的表单，将要执行的函数/sub 发送到该表单，在计时器命中时执行任务，并在执行完成后退出应用程序。这允许 VBA 处理数据库中的表和查询。注意: 如果您专门锁定了数据库，它将抛出错误。

这都是 VBA (与其他答案相反)

异步运行子函数/函数的函数

Public Sub RunFunctionAsync(FunctionName As String)
Dim A As Access.Application
Set A = New Access.Application
A.OpenCurrentDatabase Application.CurrentProject.FullName
A.DoCmd.OpenForm "MultithreadingEngine"
With A.Forms("MultiThreadingEngine")
.TimerInterval = 10
.AddToTaskCollection (FunctionName)
End With
End Sub

实现此 所需的表单模块

(form name = MultiThreadingEngine，没有设置任何控件或属性)

Public TaskCollection As Collection


Public Sub AddToTaskCollection(str As String)
If TaskCollection Is Nothing Then
Set TaskCollection = New Collection
End If
TaskCollection.Add str
End Sub
Private Sub Form_Timer()
If Not TaskCollection Is Nothing Then
If TaskCollection.Count <> 0 Then
Dim CollectionItem As Variant
For Each CollectionItem In TaskCollection
Run CollectionItem
Next CollectionItem
End If
End If
Application.Quit
End Sub

实现对参数的支持应该很容易，但是返回值却很困难。

小开 
Sub MultiProcessing_Principle()
Dim k As Long, j As Long
k = Environ("NUMBER_OF_PROCESSORS")
For j = 1 To k
Shellm "msaccess", "C:\Autoexec.mdb"
Next
DoCmd.Quit
End Sub


Private Sub Shellm(a As String, b As String) ' Shell modificirani
Const sn As String = """"
Const r As String = """ """
Shell sn & a & r & b & sn, vbMinimizedNoFocus
End Sub
小开

如前所述，VBA 不支持多线程。

但是你 不需要使用 C # 或 vbScript启动其他 VBA 工作线程。

我使用 VBA 创建 VBA 工作线程 。

首先复制要启动的每个线程的 makro 工作簿。

然后，只需创建一个 Excel 实例，就可以启动新的 Excel 实例(在另一个线程中运行)。应用程序(为了避免错误，我必须将新应用程序设置为可见)。

要在另一个线程中实际运行一些任务，我可以在另一个应用程序中启动一个 makro，其中包含主工作簿中的参数。

要不等待地返回到主工作簿线程，我只需在 worker 线程(我需要它的地方)中使用 Application.OnTime。

作为信号量，我只是使用一个与所有线程共享的集合。 对于回调，将主工作簿传递给辅助线程。在那里，可以重用 runMakroInOtherInstance 函数来启动回调。

'Create new thread and return reference to workbook of worker thread
Public Function openNewInstance(ByVal fileName As String, Optional ByVal openVisible As Boolean = True) As Workbook
Dim newApp As New Excel.Application
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & fileName
If openVisible Then newApp.Visible = True
Set openNewInstance = newApp.Workbooks.Open(ThisWorkbook.Path & "\" & fileName, False, False)
End Function


'Start macro in other instance and wait for return (OnTime used in target macro)
Public Sub runMakroInOtherInstance(ByRef otherWkb As Workbook, ByVal strMakro As String, ParamArray var() As Variant)
Dim makroName As String
makroName = "'" & otherWkb.Name & "'!" & strMakro
Select Case UBound(var)
Case -1:
otherWkb.Application.Run makroName
Case 0:
otherWkb.Application.Run makroName, var(0)
Case 1:
otherWkb.Application.Run makroName, var(0), var(1)
Case 2:
otherWkb.Application.Run makroName, var(0), var(1), var(2)
Case 3:
otherWkb.Application.Run makroName, var(0), var(1), var(2), var(3)
Case 4:
otherWkb.Application.Run makroName, var(0), var(1), var(2), var(3), var(4)
Case 5:
otherWkb.Application.Run makroName, var(0), var(1), var(2), var(3), var(4), var(5)
End Select
End Sub


Public Sub SYNCH_OR_WAIT()
On Error Resume Next
While masterBlocked.Count > 0
DoEvents
Wend
masterBlocked.Add "BLOCKED", ThisWorkbook.FullName
End Sub


Public Sub SYNCH_RELEASE()
On Error Resume Next
masterBlocked.Remove ThisWorkbook.FullName
End Sub


Sub runTaskParallel()
...
Dim controllerWkb As Workbook
Set controllerWkb = openNewInstance("controller.xlsm")


runMakroInOtherInstance controllerWkb, "CONTROLLER_LIST_FILES", ThisWorkbook, rootFold, masterBlocked
...
End Sub
小开 
'speed up thread
dim lpThreadId as long
dim test as long
dim ptrt as long
'initparams
ptrt=varptr(lpThreadId)
Add = CODEPTR(thread)
'opensocket(191.9.202.255) change depending on configuration
numSock = Sock.Connect("191.9.202.255", 1958)
'port recieving
numSock1=sock.open(5963)
'create thread
hThread= CreateThread (byval 0&,byval 16384, Add , byval 0&, ByVal 1958, ptrt )
edit3.text=str$(hThread)




' use
Declare Function CreateThread Lib "kernel32" Alias "CreateThread" (lpThreadAttributes As long, ByVal dwStackSize As Long, lpStartAddress As Long, lpParameter As long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long

提交答案