通过 Access 数据库优化循环答案

【问题标题】：Optimizing loop through Access Database通过 Access 数据库优化循环
【发布时间】：2019-06-13 12:56:04
【问题描述】：

我需要帮助，通过一个由大约 280.000 行数据组成的不断扩展的 Access 数据库进行大规模循环。该程序每周添加 3000 行数据，因此宏运行时间只会增加。大约需要一小时才能完成。

完成我的程序的最佳方式是什么？我有 VBA 经验，但 SQL 知识有限。

总结的问题是，位于“此处需要帮助”中的 If 语句贯穿 3000 家公司的 280.000 行数据。

目标是在JQHistory中将公司的每周新鲜分数进行评分，但必须考虑运行宏的日期

注意：“此处需要帮助”之外的所有内容，我已在另一个宏中进行了优化。我把它留下来希望能改善问题的背景。

这是未优化的宏：

Sub OpdaterKvant()
Dim wb As Workbook
Dim ws As Worksheet
Dim DatoIn As Date
Set db = New ADODB.Connection

Set DbEQ = New ADODB.Connection

'The location of the database is determined outside the macro'
strConn = ConnectionString
db.Open strConn

Set wb = Workbooks.Open("My File Location")
Set ws = wb.Worksheets(1)

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)

Dato = Format(DateIn, "mm-dd-yyyy")

db.Execute ("DELETE * FROM JQScores")

For i = 3 To n
    Sedol = Replace(ws.Cells(i, 1), " ", "")
    Company = Left(Replace(ws.Cells(i, 2), "'", ""), Len(Replace(ws.Cells(i, 2), "'", "")) - 1)
    Country = Replace(ws.Cells(i, 3), " ", "")
    Region = Replace(ws.Cells(i, 4), " ", "")
    Sector = Replace(ws.Cells(i, 5), " ", "")
    MarketCap = Replace(Replace(ws.Cells(i, 6), " ", ""), ",", ".")
    JQRank = Replace(ws.Cells(i, 7), " ", "")
    ValueRank = Replace(ws.Cells(i, 8), " ", "")
    QualityRank = Replace(ws.Cells(i, 9), " ", "")
    MomentumRank = Replace(ws.Cells(i, 10), " ", "")
    JQScore = Replace(Replace(ws.Cells(i, 11), " ", ""), ",", ".")

    'Inserts the information into the Access database.'
    Sql = "Insert into JQScores (Sedol, Company, Region, Sector, MarketCapUSD, JQ_Rank, Value_Rank, Quality_Rank, Momentum_Rank, JQ_Score, Country) VALUES ('" & Sedol & "','" & Company & "', '" & Region & "', '" & Sector & "', " & MarketCap & ", '" & JQRank & "', '" & ValueRank & "', '" & QualityRank & "', '" & MomentumRank & "', " & JQScore & ", '" & Country & "')"
    db.Execute (Sql)

'*** HELP NEEDED IN THIS SECTION'

    If db.Execute("Select Count(Id) as NumId from JQHistory where Sedol='" & Sedol & "' and history_date=#" & Dato & "#")("NumId") = 0 Then
    Sql = "Insert into JQHistory (History_date, Sedol, Selskabsnavn, JQScore, JQ_Rank, Value_Rank, Momentum_Rank, Quality_Rank, Marketcap) VALUES (#" & Dato & "#, '" & Sedol & "','" & Company & "'," & JQScore & ", '" & JQRank & "', '" & ValueRank & "', '" & MomentumRank & "', '" & QualityRank & "', " & MarketCap & ")"
    db.Execute (Sql)

    Else
    Sql = "Update JQHistory set MarketCap=" & MarketCap & ", Selskabsnavn='" & Company & "' , JQ_Rank='" & JQRank & "', Value_Rank='" & ValueRank & "', Quality_Rank='" & QualityRank & "', Momentum_Rank='" & MomentumRank & "', JQScore=" & JQScore & " WHERE SEDOL='" & Sedol & "' and History_Date=#" & Dato & "#"
    db.Execute (Sql)
    End If

'***'

Next i

db.Close
wb.Close

【问题讨论】：

嗯，看起来您不能使用访问权限创建多个插入语句：stackoverflow.com/questions/62504/…。真的有必要每天删除表中100%的数据然后插入280k+行吗？有没有更好的方法来构建不涉及该步骤的信息或数据？
您误解了我试图改进上下文的尝试。它在名为“JQScores”和“JQHistory”的数据库之间交替。 JQScores 由每周更新的 3.000 行组成，其中 JQHistory 是由 280.000 行 JQScores 组成的时间序列，每周添加以显示随时间的演变:)
不执行SQL，而是使用DAO打开Access数据库，然后使用AddNew和Update方法添加记录。它会更快。或者将其上下颠倒并使用 Access 导入电子表格。
谢谢。您知道使用 DAO 将列过滤到特定日期的方法吗？
执行不适用于 SELECT，只能用于 SQL 操作（DELETE、INSERT、UPDATE）。在 Access 中，使用域聚合，例如 DCount 或 DLookup 或 DSum。在 Excel 中打开一个记录集对象和引用字段。

标签： sql excel vba ms-access

【解决方案1】：

最终的最佳方式是使用 DAO.Recordset 和 DAO.Database 选项，并进行了很多优化调整。

最大的捷径是使用 'Recordset.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

【讨论】：

我建议更改数据结构。您应该插入所有 Excel 数据，包括时间戳，然后每个 History_Date 的最大时间戳代表您的实际数据，并且您可以获得插入数据的历史记录，因为您还可以查询低于您想要查看的日期的最大时间戳数据在。
除了结构之外，您还可以使用 SQL 查询 Excel 范围（例如SELECT * FROM [Sheet1$A1: CV5000]），然后加入以确定数据是否存在，导致 2 个查询的原因（插入连接字段为 NULL 的位置，更新什么不是）。或者创建一个记录集（例如：Range to Recordset Without Making Connection，而不是创建一个数组来循环遍历 excel 数据。
1.更新数据结构；由于人们依赖数据，在我的情况下是不可能的。 2、加入数据；这是否可以将更新减少到 1 个查询？尽管更新场景很少见，但最好将运行时间从 12 分钟缩短到几秒。
1：更改数据结构是一个长期目标，不能一下子完成，但应牢记。 2：如果您使用 SQL Select likeSELECT * FROM [Sheet1$A1: CV5000]获取 Excel 数据，您可以将其加入其他表。只需调整工作表和范围并将其用作子查询。