Question

我擅长从访问数据库中提取查询以显示基于某些条件的数据但是我有另一张表，用户可以在本周输入数据，并在用户点击按钮时通过VBA进入访问状态分配给它的宏。

我相信我的suedo代码应该是这样的。

load data from access onto sheet2
compare  sheet1 data to sheet2 if different show cell in red.
on update only enter sheet1 data if different to sheet2

我已经设置了访问数据库并设置了电子表格但是我正在尝试对其进行微调，以便我可以将其推广到我的团队工作中，这样他们就可以管理自己的工作时间并将其更新到访问权限中日志数据库并生成报告。

希望这很清楚

（我目前在vba中插入访问代码看起来像这样）

＆＃13;

    Option Explicit
    Const TARGET_DB = "kpistats.accdb"

    Sub PushkpidataToAccess()
        Dim cnn As ADODB.Connection
        Dim MyConn
        Dim rst As ADODB.Recordset
        Dim i As Long, j As Long
        Dim Rw As Long
        
        Sheets("data").Activate
        Rw = Range("A65536").End(xlUp).Row

        Set cnn = New ADODB.Connection
        MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
        
        With cnn
            .Provider = "Microsoft.ACE.OLEDB.12.0"
            .Open MyConn
        End With

        Set rst = New ADODB.Recordset
        rst.CursorLocation = adUseServer
        rst.Open Source:="data", ActiveConnection:=cnn, _
                 CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
                 Options:=adCmdTable
        
        'Load all records from Excel to Access.
        For i = 2 To Rw
            rst.AddNew
            For j = 1 To 8
                rst(Cells(1, j).Value) = Cells(i, j).Value
            Next j
            rst.Update
        Next i
        
        ' Close the connection
        rst.Close
        cnn.Close
        Set rst = Nothing
        Set cnn = Nothing

    End Sub

＆＃13;

非常感谢

西蒙

Answer 1

如果方法是检查每一行以查看它是否在Sheet2中重复，则插入记录（如果不是），我建议添加一个新列在表1（比如第I列）中，添加“检查是否匹配”＃39; TRUE / FALSE字段，然后在For循环中添加一个条件，只有在它不匹配时才插入。

    Option Explicit
    Const TARGET_DB = "kpistats.accdb"

    Sub PushkpidataToAccess()
        Dim cnn As ADODB.Connection
        Dim MyConn
        Dim rst As ADODB.Recordset
        Dim i As Long, j As Long
        Dim Rw As Long

        Sheets("data").Activate
        Rw = Range("A65536").End(xlUp).Row

        Set cnn = New ADODB.Connection
        MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB

        With cnn
            .Provider = "Microsoft.ACE.OLEDB.12.0"
            .Open MyConn
        End With

        Set rst = New ADODB.Recordset
        rst.CursorLocation = adUseServer
        rst.Open Source:="data", ActiveConnection:=cnn, _
                 CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
                 Options:=adCmdTable

        'Add the Match field to column i 
        Range("I2:I" & rw).Formula = "=IF(ISERROR(MATCH(A2,Sheet2!A:A,FALSE)),FALSE,TRUE)"

        'Load all records from Excel to Access.
        For i = 2 To Rw
            If Cells(i, 9) = True Then
                rst.AddNew
                For j = 1 To 8
                    rst(Cells(1, j).Value) = Cells(i, j).Value
                Next j
                rst.Update

            End If
        Next i


        ' Close the connection
        rst.Close
        cnn.Close
        Set rst = Nothing
        Set cnn = Nothing

    End Sub

另一个替代方案可能更容易，在您插入的表上放置一个Unique约束，然后在开始插入记录之前执行On Error Resume Next - Excel将无法插入重复项，但会继续尝试直到它到达最后一行。

如果不同的显示单元格为红色，则将excel中的数据与访问数据进

1 个答案: