簡體   English   中英

VBA - 加速 Access 發送的 Excel 指令

[英]VBA - Speeding up Excel instructions sent by Access

為了構建報告,我使用 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 中運行它。

我知道你提到你在 Access 中有很多自定義過程來生成各種報告,但是有什么理由不能將該代碼移動到 Excel 中嗎? 我已經構建了幾個在 Excel 中運行代碼的解決方案,但使用 Access 作為數據源,它們速度非常快 - 您在 Access 中構建的用於自定義報告的用戶表單必須在 Excel 中重建,但可以解決 Excel 之間的性能問題/使用權...

希望這會有所幫助,TheSilkCode

“瓶頸”運行了 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.

我不知道它是否仍然打開,但我遇到了類似的問題。

第一次,當我遇到這樣的問題是在使用 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

當您使用 Recordset 時,您可以使用

.Range("A2").CopyFromRecordset rs

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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM