使用多表 excel 更新多表 MS 访问文件

Question

我将表格（DKt 和 DTt）从 ms access 文件导入到 Excel 表格（DKe 和 DTe） ，每个表格对应一张表格。 现在我想更新 ms 文件，当 excel 文件中发生一些变化时。 我为不同的工作表和表格编写了不同的循环，如代码所示，但我有 8000 多行，需要很长时间才能运行。 这是唯一的方法还是有另一种方法来为所有表格和工作表编写循环？ 当我在旧版本的 microsoft (2013) 中为lastrow = Workbooks(1).Sheet("DKe").Cells(Workbooks(1).Sheet("DKe").Rows.Count, "A").End(xlUp).Row行运行宏时，我也遇到错误lastrow = Workbooks(1).Sheet("DKe").Cells(Workbooks(1).Sheet("DKe").Rows.Count, "A").End(xlUp).Row Subscript out of range ，我怎样才能得到不同版本的结果？ 这是我的宏，用于从 Excel 工作表更新 ms 文件中的表格：

`Sub UpdateMDB()
Dim accConn As Object, accRST As Object
Dim accFile As String, accStr As String
Dim lastrow As Long, i As Long
Const adOpenKeyset = 1, adLockOptimistic = 3, adCmdTableDirect = 512
Dim accConn2 As Object, accRST2 As Object, lastrow2 As Long
lastrow =     Workbooks(1).Sheet("DKe").Cells(Workbooks(1).Sheet("DKe").Rows.Count, "A").End(xlUp).Row
''lastrow2 = Workbooks(1).Sheets("Dte").Cells(Workbooks(1).Sheets("DTe").Rows.Count, "A").End(xlUp).Row

accFile = "Z:\Documents\Database\Database1.mdb"
accStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & accFile & ";"

Set accConn = CreateObject("ADODB.Connection")
''Set accConn2 = CreateObject("ADODB.Connection")
Set accRST = CreateObject("ADODB.Recordset")
''Set accRST2 = CreateObject("ADODB.Recordset")

accConn.Open accStr

'' Update for DK
accRST.Open "SELECT * FROM DKt", accConn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
If Not (accRST.BOF And accRST.EOF) Then
accRST.MoveFirst
Else
MsgBox "No records in Access table.", vbInformation
accRST.Close: accConn.Close: Set accRST = Nothing: Set accConn = Nothing
Exit Sub
End If

Do While Not accRST.EOF
For i = 1 To lastrow
    If accRST!ID = Workbooks(1).Sheet("DKe").Range("A" & i) _
            And accRST!DK <> Workbooks(1).Sheet("DKe").Range("B" & i) Then
       accRST!DK.Value = Workbooks(1).Sheet("DKe").Range("B" & i)
    End If
Next i
accRST.Update
accRST.MoveNext
Loop

accRST.Close: accConn.Close
Set accRST = Nothing: Set accConn = Nothing

'' Update for DT
''accRST2.Open "SELECT * FROM DTt", accConn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
''If Not (accRST2.BOF And accRST2.EOF) Then
''    accRST2.MoveFirst
''Else
 ''    MsgBox "No records in Access table.", vbInformation
 ''    accRST2.Close: accConn.Close: Set accRST2 = Nothing: Set accConn = Nothing
''    Exit Sub
''End If

''Do While Not accRST2.EOF
''   For i = 1 To lastrow2
''       If accRST2!ID = Workbooks(1).Sheets("DTe").Range("A" & i) _
''               And accRST2!DT <> Workbooks(1).Sheets("DTe").Range("B" & i) Then
''          accRST2!DT.Value = Workbooks(1).Sheets("DTe").Range("B" & i)
''       End If
''   Next i
''   accRST2.Update
''   accRST2.MoveNext
''Loop

''accRST2.Close: accConn.Close
''Set accRST2 = Nothing: Set accConn = Nothing

End Sub

Answer 1

看起来问题始于update for DK的行update for DK 。 你可以试试跟随吗？ 或者到目前为止你是如何解决的？

`accConn.Open accStr
 accRST.Open "SELECT * FROM "DKt", accConn, adOpenKeyset, adLockOptimistic, 
 adCmdTableDirect
 If Not (accRST.BOF And accRST.EOF) Then
 accRST.MoveFirst
 Else
 MsgBox "No records in Access table.", vbInformation
 accRST.Close: accConn.Close: Set accRST = Nothing: Set accConn = Nothing
 Exit Sub
 End If
 For i = 2 To lastrow 
 If accRST!ID = Workbooks(1).Sheets("DKe").Range("A" & i) _
 And accRST!DK <> Workbooks(1).Sheets("DKe").Range("B" & i) Then
 accRST!DK.Value = Workbooks(1).Sheets("DKe").Range("B" & i)
 accRST.Update
 End If
 accRST.MoveNext
 Next i
 accRST.Close: accConn.Close
 Set accRST = Nothing: Set accConn = Nothing`

Answer 2

更新循环的部分更改为

`accConn.Open accStr
 accRST.Open "SELECT * FROM "DKt", accConn, adOpenKeyset, adLockOptimistic, adCmdTableDirect

  If Not (accRST.BOF And accRST.EOF) Then
  accRST.MoveFirst
  Else
 MsgBox "No records in Access table.", vbInformation
accRST.Close: accConn.Close: Set accRST = Nothing: Set accConn = Nothing
Exit Sub
End If

 For i = 2 To lastrow 
 ''(because in excel file the values start from second row and first row is name of the column)
If accRST!ID = Workbooks(1).Sheets("DKe").Range("A" & i) _
            And accRST!DK <> Workbooks(1).Sheets("DKe").Range("B" & i) Then
    accRST!DK.Value = Workbooks(1).Sheets("DKe").Range("B" & i)
    accRST.Update
End If
accRST.MoveNext
Next i
accRST.Close: accConn.Close
Set accRST = Nothing: Set accConn = Nothing
 MsgBox "DK was updated"`

之后DT的下一次更新从accConn2.Open accStr开始。