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

Question

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

想象一个有以下记录的德英词典：

 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
• 我删除了未使用的字段
• 我启动了性能分析器并进行了建议的更改（在两个字段中我更改了数据类型）
• 我将数据库拆分为仅包含表的后端和包含查询和模块的前端
• 我将后端的内容导出到一个文本文件中，然后将其重新导入到新创建的后端中
• 我在执行该功能时停止了防病毒软件（尽管防病毒软件使用了很少的处理器容量）

这些都没有显着差异。

有什么想法吗？

Answer 1

迄今为止最好的答案是来自 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

Answer 2

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

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

1. 将 Access 的原始数据导入 Excel (Sheets(1))。 （例表2）~~> 0.7617188秒
2. 通过用逗号分隔导入的 Sheets(1) 的数据来转换数据。 --> Sheets(2) ~~> 21.58594 秒
3. 通过 Access 申请从 Sheets(2) 加载数据。 ~~> 5 分钟

---

1. 导入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

---

1. 通过用逗号分隔导入的 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