Question

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

Answer 1

无法使用VBA本机完成。 VBA内置于单线程公寓中。获取多个线程的唯一方法是在VBA之外的其他东西上构建一个具有COM接口并从VBA调用它的DLL。

INFO: Descriptions and Workings of OLE Threading Models

Answer 2

您可能已经了解到VBA本身不支持多线程，但是。有3种方法可以实现多线程：

COM / dlls - 例如C＃和Parallel类在不同的线程中运行
使用VBscript工作线程 - 在单独的VBscript线程中运行您的VBA代码
使用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

Answer 3

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

基本上，您需要创建worker vbscripts来执行您想要的各种事情并将其报告回excel。对于我正在做的事情，从各种网站检索HTML数据，效果很好！

看看：

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

Answer 4

我正在添加这个答案，因为程序员从更现代的语言进入VBA并在VBA中搜索Stack Overflow进行多线程处理可能并不知道有几种原生的VBA方法，这些方法有时可以帮助弥补VBA缺乏真正的多线程。

如果多线程的动机是拥有一个响应速度更快的用户界面，并且在执行长时间运行的代码时不会挂起，那么VBA确实有一些经常在实践中工作的低技术解决方案：

1）可以使用户表单无模式显示 - 这允许用户在表单打开时与Excel交互。这可以在运行时通过将Userform的ShowModal属性设置为false来指定，也可以通过放置行来自动加载来进行指定

UserForm1.Show vbModeless

在用户表单的初始化事件中。

2）DoEvents声明。这会导致VBA放弃对OS的控制以执行事件队列中的任何事件 - 包括Excel生成的事件。典型的用例是在代码执行时更新图表。如果没有DoEvents，在运行宏之前不会重新绘制图表，但使用Doevents可以创建动画图表。这种想法的变体是创建进度表的常见技巧。在一个执行10,000,000次的循环中（由循环索引 i 控制），你可以得到一段代码，如：

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

这些都不是多线程 - 但在某些情况下它可能是一个足够的kludge。

Answer 5

我知道问题指定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

实现此目的所需的表单模块

（表单名称= 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

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

Answer 6

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

但您不需要使用C＃或vbScript 来启动其他VBA工作线程。

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

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

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

要在另一个线程中实际运行某个任务，我可以在另一个应用程序中使用参数形成主工作簿来启动makro。

要在不等待的情况下返回主工作簿线程，我只需在工作线程中使用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

Answer 7

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

Answer 8

'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

VBA中的多线程

8 个答案: