VBA - 加速 Access 发送的 Excel 指令

Question

为了构建报告，我使用 Access 计算了一些数据，然后使用 VBA 宏导出多个表，然后此宏启动 Excel 并从 Excel 中运行另一个宏以编译所有内容。

一切都已经相当快了，但是除了我的 Access VBA 之外，还需要一个带有 VBA 代码的 Excel 工作表让我感到困扰。 我最近向我的数据库添加了许多新功能，可以选择生成多个报告，并在 Access Forms 上提供大量自定义。

在这两个文件之间导航对我来说变得有些复杂，所以我尝试将我的 Excel 代码放在 Access 中，这样我的同事（最终用户）只需要在他们的计算机上保持 1 个文件是最新的，并且它也会使调试变得更容易。

报告按预期构建，但过程慢了 5 倍。 我尝试测量每个步骤所花费的时间，并且比率保持不变（除了最后构建 PowerPoint 演示文稿的部分）。

所以我决定尝试这段无用的代码：

Sub test()

Dim t As Double 'Starting time
t = Round(Timer)

Dim b As Workbook
Dim s As Worksheet
Dim i As Integer, j As Integer 'Loop variables


'Create workbook
Set b = Workbooks.Add
'Get worksheet
Set s = b.Sheets(1)

'Double Loop
For i = 1 To 100
    For j = 1 To 100
        s.Cells(i, j) = "Hi!" 'Write some useless comment
    Next
Next

b.Close False 'Close without saving

'Message
MsgBox (Round(Timer) - t) \ 60 & "'" & Format((Round(Timer) - t) Mod 60, "00") & "''"

End Sub

我没有故意放置任何 ScreenUpdating=False、EnableEvents=False 等。

从 Excel 运行代码时，需要 2 到 3 秒。

从 Access 运行代码时，需要 7 到 10 秒！

我知道 Access 必须向另一个应用程序发送指令，这可能会减慢进程。 所以我试着让 Excel 在另一个 Excel 实例中运行我的脚本（所以我创建了一个对象“Excel.Application”，我将我的工作簿放在其中，这正是 Access 在后台所做的），并且我获得了与我相同的性能从 Access 运行代码。

有什么办法可以加快速度吗？ 更改 VB 脚本与其创建的应用程序对象通信方式的指令？

预先感谢大家的支持。

编辑：根据 ASH 的要求，这是我在 Access 中运行的完整代码（我不会放我的报告代码，因为它非常庞大，有很多子项、函数、自定义类等）。 评论是法语，但这里是一个摘要：

• 第一个脚本是创建或打开 Excel 工作簿的函数，进行了一些优化（Excel 不可见、无屏幕更新、无计算等）

• 第二个脚本是关闭 Excel 工作簿的子脚本，具有保存/另存为和放弃第一个函数的优化选项

• 第三个脚本是我之前放置的测试代码的替代版本。

现在对于代码本身：

Option Explicit

Function Ouvrir_Classeur_Excel(Optional Fichier As String, Optional Optimiser As Boolean = False) As Workbook

'*********************************** Descriptif
'Ouvre (ou crée) un classeur Excel en appliquant une optimisation si demandé par l'utilisateur.
'L'optimisation cache et désactive le rafraîchissement visuel d'Excel, les messages d'alerte, les événements et les calculs automatiques.

'------------------ Paramètres
'Fichier : Le chemin du classeur à ouvrir. S'il est vide, un classeur est créé
'Optimiser : Indique si les scripts d'optimisation doivent être exécutés. Par défaut, cette option est désactivée



'*********************************** Exécution
With Excel.Application


    If Optimiser Then
        'Excel invisible
        .Visible = False
        'Désactivation du rafraîchissement
        .ScreenUpdating = False
        'Désactivation des messages d'alerte
        .DisplayAlerts = False
        'Désactivation des événements
        .EnableEvents = False
    End If

    'Ouverture/Création du classeur
    If Fichier <> "" Then Set Ouvrir_Classeur_Excel = Workbooks.Open(Fichier) 'Si on a spécifié un fichier, il est ouvert
    If Fichier = "" Then Set Ouvrir_Classeur_Excel = Workbooks.Add 'Si on n'a pas spécifié de fichier, on en crée un

    'Désactivation des calculs automatiques
    If Optimiser Then .Calculation = xlCalculationManual

End With

End Function




Sub Fermer_Classeur_Excel(Classeur As Workbook, Optional Enregistrer As Boolean = False, _
    Optional Emplacement As String, Optional Fin_Optimisation As Boolean = False)

'*********************************** Descriptif
'Ferme le classeur Excel spécifié.
'Si l'utilisateur le demande, le classeur peut être enregistré, ou enregistré sous.
'Si l'utilisateur le demande, les optimisations appliquées par la fonction Ouvrir_Classeur_Excel peuvent être annulées.

'------------------ Paramètres
'Classeur : Le classeur à fermer
'Enregistrer : Indique si le classeur doit être enregistré. Par défaut, cette option est désactivée
'Emplacement : Indique l'emplacement où enregistrer le classeur. Si vide, l'enregistrement sera simple.
'Fin_Optimisation : Indique si les optimisations doivent être annulées. Par défaut, cette option est désactivée



'*********************************** Exécution
With Excel.Application

    'Enregistrement du classeur
    If Enregistrer Then
        If Emplacement = "" Then Classeur.Save
        If Emplacement <> "" Then Classeur.SaveAs Emplacement
    End If

    'Réactivation des calculs automatiques
    If Fin_Optimisation Then .Calculation = xlCalculationAutomatic

    'Fermeture du classeur
    Classeur.Close False


    If Fin_Optimisation Then
        'Réactivation du rafraîchissement
        .ScreenUpdating = True
        'Réactivation des messages d'alerte
        .DisplayAlerts = True
        'Réactivation des événements
        .EnableEvents = False
    End If

End With

End Sub




Sub testA()

'------------Relève de l'heure de début
Dim tGlo As Double 'Heure de début d'exécution du script
Dim infoFin As String
tGlo = Round(Timer)

Dim x As Excel.Application
Dim c As Workbook
Dim f As Worksheet
Dim i As Integer, j As Integer

Set c = Ouvrir_Classeur_Excel(, True)

Set f = c.Sheets(1)
i = 1
Do Until i = 100
    j = 1
    Do Until j = 100
        f.Cells(i, j) = "Coucou"
        j = j + 1
    Loop
    i = i + 1
Loop

Fermer_Classeur_Excel c, , , True


'------------Message de fin
infoFin = infoFin & Chr(10) & Chr(10) & "DUREE DE TRAITEMENT : " & (Round(Timer) - tGlo) \ 60 & "'" & Format((Round(Timer) - tGlo) Mod 60, "00") & "''"
MsgBox infoFin, , title:="** FIN DU TRAITEMENT **"


End Sub

像这样，它需要 2 到 7 秒（Excel 已经在运行），与相同优化的 Excel 中的不到 1 秒相比，这是巨大的。

问题是它在这里似乎并不那么重要，但是另一个在 Excel 中通常需要 40 秒的过程，当我将它迁移到 Access 时花费了 3 多分钟。 我还有一个（尚未优化）在 Excel 中花费的时间超过 3:30，我什至不敢尝试在 Access 中运行它。

Answer 1

我知道你提到你在 Access 中有很多自定义过程来生成各种报告，但是有什么理由不能将该代码移动到 Excel 中吗？ 我已经构建了几个在 Excel 中运行代码的解决方案，但使用 Access 作为数据源，它们速度非常快 - 您在 Access 中构建的用于自定义报告的用户表单必须在 Excel 中重建，但可以解决 Excel 之间的性能问题/使用权...

希望这会有所帮助，TheSilkCode

Answer 2

“瓶颈”运行了 100*100 次 [s.Cells(i,j) = "Hi!"]

For i = 1 To 100
    For j = 1 To 100
        s.Cells(i, j) = "Hi!" 'Write some useless comment
    Next
Next

要解决此问题，请尝试仅将“瓶颈”作为 [Rg.Value = D2] 运行一次

Dim Ws as Worksheet: Set Ws = Sheets(1)
Dim C1 as Range:     Set C1 = Ws.Cells(2,2)     ' Cell1 - The top-left-corner
Dim C2 as Range:     Set C2 = Ws.Cells(101,202) ' Cell2 - The bottom-right-corner
Dim Rg as Range:     Set Rg = Ws.Range(C1,C2)   ' Rg - the Rectangle Range At-Top-Left-Cell(2,2) of 100 Rows and 200 columns
Dim D2(): Redim D2(1-100,1-200)                 ' D2 - The 2-dimension array of 100 rows and 200 columns
For R%=1 to 100
    For C%=1 to 200
        D2(R,C)=R*100+C
    Next
Next
Rg.Value = D2                                   ' Run the "Bottle neck" only once.

Answer 3

我不知道它是否仍然打开，但我遇到了类似的问题。

第一次，当我遇到这样的问题是在使用 VSTO 通过 C# 自动化 Excel 时。 VSTO 在读取和写入工作表中的单元格时存在巨大问题，例如，我能够通过 VBA 以快 40 倍的速度执行相同的操作。 然后我发现，使用数组读取和写入 Excel 单元格要快得多（警告 - 在 C# 的情况下，我在使用这种概念时遇到内存不足的问题，我不得不使用像 100k 行和 40 列这样的数组来划分一张工作表）。

这个想法是： - 在读取的情况下，将所有有趣的单元格复制到数组，然后遍历数组， - 在写入的情况下，创建数组并将值复制到数组，然后将数组复制到工作表中的适当单元格。

在VBA中通过数组读取单元格你可以这样做：

Dim arr As Variant 'declare array
Dim LC As Long 'last column
Dim LR As Long 'last Row
'ws is worksheet variable


LC = ws.UsedRange.Columns(ws.UsedRange.Columns.Count).Column
LR = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
arr = (Range(ws.Cells(1,1), ws.Cells(LR, LC)).Value) 'copy cells from A1 to last column and last row

Dim r As Long 'r - is var for row
Dim c As Long 'c - is var for column

For r = 1 To LR
    For c = 1 To LC
      ' do sth with value from cells
      MsgBox(Cstr(arr(r,c))) 'eg. I display value of cell in MsgBox
    Next c
Next i

Answer 4

当您使用 Recordset 时，您可以使用

.Range("A2").CopyFromRecordset rs

https://docs.microsoft.com/ru-ru/office/vba/api/excel.range.copyfromrecordset