通过 VBA 拆分 Access 数据库需要很长时间

Question

我有一个 MS Access 数据库。数据库版本是 2002-2003（因此是 mdb）。从该数据库中，我将几个字段导出到临时 table 中，以便在网站上表示它们。由于有一个字段有多个逗号分隔的条目，我将它们拆分，以便每个记录每个字段只有一个条目。

假设一本德英词典有以下记录：

 en | de
 building | Gebäude,Bauwerk

我想拆分如下：

 en | de
 building | Gebäude
 building | Bauwerk

我使用的 VBA 函数过去工作正常。该数据库有大约 100.000 条记录。拆分过去大约需要 30 分钟。现在需要一整天。

这是函数：

    Public Sub commasplitfield4()
    Dim rstObj As DAO.Recordset, dbObj As DAO.Database
    Dim InsertSQL As String
    Set dbObj = CurrentDb()
    Set rstObj = dbObj.OpenRecordset("qry-export")
    DoCmd.SetWarnings False
    Do While Not rstObj.EOF
        Dim memArr() As String
        memArr = Split(rstObj.Fields("field4"), ",")
        For i = 0 To UBound(memArr)
            InsertSQL = "INSERT INTO exporttemp(field1,field2,field3,field4) VALUES (""" & rstObj.Fields("field1") _
            & """, """ & rstObj.Fields("field2") _
            & """, """ & rstObj.Fields("field3") & """, """ & memArr(i) & """)"
            DoCmd.RunSQL (InsertSQL)
        Next
        rstObj.MoveNext
    Loop
DoCmd.SetWarnings True
End Sub

我不能说它到底是从什么时候开始需要这么长时间的，但我可以说从 Windows 7 更改为 Windows 10 并没有什么不同。我在 Windows 10 上使用了很长时间，但它以前仍然运行良好。此外，从 Access 2007 迁移到 2010，然后迁移到 2019 并没有什么不同，至少一次没有。

为了检查错误可能出在哪里，我检查了以下清单：

我在启动函数之前压缩了数据库
我尝试在 Windows 7 兼容模式下启动 Access
我删除了未使用的字段
我启动了性能分析器并进行了建议的更改（在两个字段中我更改了数据类型）
我将数据库拆分为仅包含 table 的后端和包含查询和模块的前端
我将后端的内容导出到一个文本文件中，然后将其重新导入到一个新创建的后端中
我在执行该功能时停止了杀毒软件（尽管杀毒软件使用的处理器容量很小）

None 没有table 差异。

有什么想法吗？

Answer 1

我无法解释你的问题的确切原因，但我认为循环遍历记录集和循环数组需要很多时间。

在 Excel 中使用 vba 用逗号分隔字符似乎更快。示例源数据是 1000000 条记录，每个逗号分隔的内容每条记录写两条，转换后的数据记录以2000000条数据测试

将Access的原始数据导入Excel(Sheets(1))。 (例表2)~~> 0.7617188秒
转换数据，将导入的Sheets(1)数据用逗号隔开。 --> 页数(2) ~~> 21.58594 秒
通过 Access 应用程序从 Sheets(2) 加载数据。 ~~> 5 分钟

导入Access原始数据

 Sub exeSQLgetdata()
 
    Dim Rs As ADODB.Recordset
    Dim strConn As String
    Dim i As Integer
    Dim Fn As String
    Dim Ws As Worksheet
    
    Dim st, et
    
    st = Timer
    
    Set Ws = Sheets(1)
    
    Fn = ThisWorkbook.Path & "\" & "Database9.accdb" '<~~ your database path & name
    
    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & Fn & ";"
 
    Set Rs = CreateObject("ADODB.Recordset")
    strSQL = "Select field1,field2, field3, field4  from [table2]" '<~~ your raw data table
    
    Rs.Open strSQL, strConn
    
    If Not Rs.EOF Then
        With Ws
            For i = 0 To Rs.Fields.Count - 1
                .Cells(1, i + 1) = Rs.Fields(i).Name
            Next i
            .UsedRange.Offset(1).Clear
            .Range("a2").CopyFromRecordset Rs
        End With
    End If
    Rs.Close
    Set Rs = Nothing
    et = Timer
    
    Debug.Print "Get Data time : " & et - st & " seconds" '<~~ get data from access database
End Sub

转换数据，将导入的Sheets(1)的数据用逗号分隔。

Sub splitData()
    Dim vR(1 To 1000000, 1 To 4)
    Dim vDB As Variant
    Dim i As Long, n As Long
    Dim k As Variant, v As Variant
    Dim Ws As Worksheet
    Dim toWs As Worksheet
    Dim st, et
    
    st = Timer
    
    Set Ws = Sheets(1)
    Set toWs = Sheets(2)
    
    vDB = Ws.Range("a1").CurrentRegion
    
    For i = 1 To UBound(vDB, 1)
        k = Split(vDB(i, 4), ",")
        For Each v In k
            n = n + 1
            vR(n, 1) = vDB(i, 1)
            vR(n, 2) = vDB(i, 2)
            vR(n, 3) = vDB(i, 3)
            vR(n, 4) = v
        Next v
        DoEvents
    Next i

    With toWs
        .UsedRange.Clear
        .Range("a1").Resize(UBound(vR, 1), UBound(vR, 2)) = vR
    End With
    et = Timer
    Debug.Print "Split time : " & et - st & " seconds"
End Sub

Answer 2

迄今为止最好的答案是来自 HansUp 的答案。现在只需几分钟，而不是一整天。我什至不能恰当地感谢 HansUp，因为他把解决方案放在了旁注中。

令人惊讶的是，实际上我几乎不需要更改代码。所以，解决方案是修改代码如下：

Public Sub commasplitfield4()
    Dim rstObj As DAO.Recordset, dbObj As DAO.Database
    Dim InsertSQL As String
    Set dbObj = CurrentDb()
    Set rstObj = dbObj.OpenRecordset("qry-export")
    DoCmd.SetWarnings False
    Do While Not rstObj.EOF
        Dim memArr() As String
        memArr = Split(rstObj.Fields("field4"), ",")
        For i = 0 To UBound(memArr)
            InsertSQL = "INSERT INTO exporttemp(field1,field2,field3,field4) VALUES (""" & rstObj.Fields("field1") _
            & """, """ & rstObj.Fields("field2") _
            & """, """ & rstObj.Fields("field3") & """, """ & memArr(i) & """)"
            'DoCmd.RunSQL (InsertSQL)
            dbObj.Execute (InsertSQL), dbFailOnError 'this line made the difference
        Next
        rstObj.MoveNext
    Loop
'DoCmd.SetWarnings True
End Sub

通过 VBA 拆分 Access 数据库需要很长时间

Splitting Access database via VBA takes suddenly ages

vba

ms-access

database-performance