Оптимизация цикла через базу данных Access

Оптимальным путем оказалось использование опций DAO.Recordset и DAO.Database, а также множество настроек для оптимизации.

Самым большим сокращением было использование «Набор записей.FindFirst», чтобы определить, следует ли только добавлять данные (занимает 22 секунды) или обновлять данные с идентичной датой (занимает 12 минут). Хотя в основном будет происходить сценарий на 22 секунды.

Сценарий на 12 минут не оптимизирован, так как встречается редко.

Полное решение:

Sub OpdaterKvant()

Dim wb As Workbook
Dim wbOp As Workbook
Dim ws As Worksheet
Dim wsOp As Worksheet
Dim i, n As Integer

Dim db As DAO.Database
Dim rsScores As DAO.Recordset
Dim rsHistory As DAO.Recordset

StartTime = Timer

Call PERFORMANCEBOOST(False)

Set PB = CREATEPROGRESSBAR
    With PB
        .SetStepCount (4)
        .Show
        End With

    Set wbOp = ThisWorkbook
    Set wsOp = wbOp.ActiveSheet

'Step 1: Open JQGCLE
    Set wb = Workbooks.Open("Location", ReadOnly:=True)
    Set ws = wb.Worksheets(1)
        ws.Activate

    n = ws.UsedRange.Rows.Count

    DateIn = Right(ws.Cells(1, 1), 2) & "-" & Mid(ws.Cells(1, 1), 5, 2) & "-" & Left(ws.Cells(1, 1), 4)

'Step 2: Optag værdier i Excel
    PB.Update "Data hentes fra JQGLCE-ark"

    ReDim Sedol(3 To n) As String
    ReDim Company(3 To n) As String
    ReDim Country(3 To n) As String
    ReDim Region(3 To n) As String
    ReDim Sector(3 To n) As String
    ReDim MarketCap(3 To n) As String 'Tal
    ReDim MarketCapSQL(3 To n) As String 'Tal
    ReDim JQRank(3 To n) As String
    ReDim ValueRank(3 To n) As String
    ReDim QualityRank(3 To n) As String
    ReDim MomentumRank(3 To n) As String
    ReDim JQScore(3 To n) As String 'Tal
    ReDim JQScoreSQL(3 To n) As String 'Tal

    For i = 3 To n

        Sedol(i) = Trim(ws.Cells(i, 1))
        Company(i) = Left(Replace(ws.Cells(i, 2), "'", ""), Len(Replace(ws.Cells(i, 2), "'", "")) - 0) 'Stod tidligere på minus 1 - Hvorfor?
        Country(i) = Trim(ws.Cells(i, 3))
        Region(i) = Trim(ws.Cells(i, 4))
        Sector(i) = Trim(ws.Cells(i, 5))
        MarketCap(i) = ws.Cells(i, 6) 'Til DAO
        MarketCapSQL(i) = Replace(ws.Cells(i, 6), ",", ".") 'Til SQL
        JQRank(i) = Trim(ws.Cells(i, 7))
        ValueRank(i) = Trim(ws.Cells(i, 8))
        QualityRank(i) = Trim(ws.Cells(i, 9))
        MomentumRank(i) = Trim(ws.Cells(i, 10))
        JQScore(i) = ws.Cells(i, 11) 'Til DAO
        JQScoreSQL(i) = Replace(ws.Cells(i, 11), ",", ".") 'Til SQL

        'DAO og SQL bliver behandlet forskelligt ift. komma

        Next i

'Step 3: Indsæt værdier i Access-database
    Set acc = New Access.Application
    Set db = acc.DBEngine.OpenDatabase("Location", 1, 0)

    'Step 3.1: JQScores
        PB.Update "JQScores indsættes i databasen"

        Set rsScores = db.OpenRecordset(Name: = "JQScores", Type:=RecordsetTypeEnum.dbOpenDynaset)
        db.Execute "DELETE * FROM JQScores"

        For i = 3 To n

            With rsScores
                .AddNew
                !Sedol = Sedol(i)
                !Company = Company(i)
                !Region = Region(i)
                !Sector = Sector(i)
                !MarketCapUSD = MarketCap(i)
                !JQ_Rank = JQRank(i)
                !Value_Rank = ValueRank(i)
                !Quality_Rank = QualityRank(i)
                !Momentum_Rank = MomentumRank(i)
                !JQ_Score = JQScore(i)
                !Country = Country(i)
                .Update

                End With

            Next i

            rsScores.Close
        Set rsScores = Nothing

    'Step 3.2: JQHistory
        Set rsHistory = db.OpenRecordset(Name: = "JQHistory", Type:=RecordsetTypeEnum.dbOpenDynaset)

        With rsHistory

        If .RecordCount <> 0 Then

        i = 3

        .FindFirst "History_Date = '" & DateIn & "'"
            If .NoMatch = True Then
            'Hvis datoen ikke er i datasættet, bliver dataen tilføjet

                PB.Update "Hurtig: JQHistory indsættes i databasen"

                For i = 3 To n
                    .AddNew
                    !History_Date = DateIn
                    !Sedol = Sedol(i)
                    !Selskabsnavn = Company(i)
                    !MarketCap = MarketCap(i)
                    !JQ_Rank = JQRank(i)
                    !Value_Rank = ValueRank(i)
                    !Quality_Rank = QualityRank(i)
                    !Momentum_Rank = MomentumRank(i)
                    !JQScore = JQScore(i)
                    .Update

                    Next i

                Else
                'Hvis datoen allerede er der, skal den opdateres
                    PB.Update "Langsom: JQHistory indsættes i databasen"

                    For i = 3 To n

                        db.Execute ("UPDATE JQHistory SET MarketCap = " & MarketCapSQL(i) & ", Selskabsnavn='" & Company(i) & "', JQ_Rank='" & JQRank(i) & "', Value_Rank='" & ValueRank(i) & "', Quality_Rank='" & QualityRank(i) & "', Momentum_Rank='" & MomentumRank(i) & "', JQScore = " & JQScoreSQL(i) & " WHERE SEDOL='" & Sedol(i) & "' and History_Date='" & DateIn & "'")

                        Next i

                End If

            End If
            End With

            rsHistory.Close
        Set rsHistory = Nothing

'Step 4: Færdiggørelse

    acc.DoCmd.Quit acQuitSaveAll 'Lukker og gemmer database
    Set db = Nothing

    wsOp.Activate
    wsOp.Range("B7").Value = "Seneste data benyttet: " & DateIn
    wb.Close SaveChanges:=False

    Call PERFORMANCEBOOST(True)

    Unload PB

    MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

    MsgBox "Opdatering fuldført. Proceduren tog " & MinutesElapsed & "."

End Sub