比较 excel 中的数据以访问数据，如果不同则以红色显示单元格答案

【问题标题】：compare data in excel to access data if different show cell in red比较 excel 中的数据以访问数据，如果不同则以红色显示单元格
【发布时间】：2015-03-23 02:35:23
【问题描述】：

我有 excel 从访问数据库中提取查询以根据某些条件显示数据，但是我有另一张表，用户可以在其中输入一周的数据，并且当用户单击按钮时通过 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 中插入访问代码如下所示）

    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

非常感谢

西蒙

【问题讨论】：

你能给用户一个Access表单来输入一周的数据吗？
您可以使用Conditional Formatting using a formula突出显示无效数据
我不使用访问表单的原因是每个人（最多 20 个）都有自己的电子表格或者在这种情况下使用访问表单会更好吗？
假设您在 Access 表中添加了一个 user_id 字段。然后创建一个 Access 表单（不是 20 个表单），它只向用户显示与他或她的 user_id 关联的那些行。并且当用户添加新记录时，会自动包含正确的 user_id。那么您是否还需要 20 个 Excel 工作表？如果没有，我相信 Access 表单解决方案应该比您描述的 Excel 方法简单得多。 OTOH，如果您精通 Excel 而不是 Access，那么 Access 解决方案可能不适合您。
另一方面，@HansUp、Access 和 Excel VBA 足够接近，如果您了解另一个，学习其中一个并不难。我同意您对在 Access 中完成所有操作的评估。最大的缺点是，尽管 Microsoft 另有声明，但 Access 对于 20 个并发用户来说确实很糟糕（超过 10 个正在变得粗略）。不过，有很多方法可以解决这个问题，其中许多都记录在 SO 和网络上的其他地方。

标签： vba excel ms-access

【解决方案1】：

如果方法是检查每一行以查看它是否在 Sheet2 中重复，然后插入一条记录，如果不是，我建议让它在工作表 1 中添加一个新列（比如第一列），添加一个“检查是否匹配”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

另一种选择可能更简单，在要插入的表上设置唯一约束，然后在开始插入记录之前执行 On Error Resume Next - Excel 将无法插入重复项，但会继续尝试直到到达最后一行。

【讨论】：