通过Excel VBA操作Access兼容数据库跨行复制多列值（含例外）

看你的场景，应该是要把符合特定条件行里的非空列值，复制到另一行的空列里对吧？结合你给的示例数据（比如Del=False的行有值，Del=True的行大部分空），我给你写个实用的VBA方案，直接能用：

先做准备工作 #

首先得确保Excel能连得上Access数据库：

• 要么用早期绑定：打开VBA编辑器（Alt+F11），点「工具」→「引用」，勾选Microsoft ActiveX Data Objects 6.1 Library（选最新的版本就行）
• 嫌麻烦就用后期绑定：代码里直接创建对象，不用手动加引用，兼容性更好

核心VBA代码（直接复制用） #

这个代码的逻辑是：按Cat分组，把同组内Del=False行的非空值，填充到Del=True行的空列里。你可以根据自己的实际条件改WHERE子句：

Sub CopyNonNullDataToTargetRow()
    Dim conn As Object, rsSource As Object, rsTarget As Object
    Dim strDBPath As String, strConn As String, strSQL As String
    Dim strUpdateCols As String, fieldName As String
    Dim i As Integer
    
    ' 把这里改成你的MDB文件路径！
    strDBPath = "C:\YourFolder\YourDatabase.mdb"
    
    ' JET引擎的连接字符串，专门针对.mdb文件
    strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & ";"
    
    ' 创建ADO对象（后期绑定，不用加引用）
    Set conn = CreateObject("ADODB.Connection")
    Set rsSource = CreateObject("ADODB.Recordset")
    Set rsTarget = CreateObject("ADODB.Recordset")
    
    On Error GoTo Cleanup
    
    ' 打开数据库连接
    conn.Open strConn
    
    ' 1. 取出源数据：Del=False的行（有值的行），按Cat分组排序
    strSQL = "SELECT ID, Cat, Col1, Col2, Col3, Col4, Col40 FROM YourTableName WHERE Del = False ORDER BY Cat, ID"
    rsSource.Open strSQL, conn, 1, 3 ' 只读游标
    
    ' 2. 取出目标数据：Del=True的行（需要填充的行），同样按Cat排序
    strSQL = "SELECT ID, Cat, Col1, Col2, Col3, Col4, Col40 FROM YourTableName WHERE Del = True ORDER BY Cat, ID"
    rsTarget.Open strSQL, conn, 2, 3 ' 可更新游标
    
    ' 3. 匹配同Cat的行，复制非空值
    rsSource.MoveFirst
    rsTarget.MoveFirst
    Do While Not rsSource.EOF And Not rsTarget.EOF
        If rsSource("Cat") = rsTarget("Cat") Then
            strUpdateCols = ""
            ' 遍历所有需要复制的列（跳过ID和Cat，从第3列开始）
            For i = 3 To rsSource.Fields.Count - 1
                fieldName = rsSource.Fields(i).Name
                ' 只复制源行非空、目标行空的列，避免覆盖已有值
                If Not IsNull(rsSource.Fields(i).Value) And IsNull(rsTarget.Fields(i).Value) Then
                    strUpdateCols = IIf(strUpdateCols <> "", strUpdateCols & ", ", "") & _
                                    fieldName & " = " & GetSQLSafeValue(rsSource.Fields(i).Value)
                End If
            Next i
            
            ' 如果有要更新的列，执行SQL
            If strUpdateCols <> "" Then
                strSQL = "UPDATE YourTableName SET " & strUpdateCols & " WHERE ID = " & rsTarget("ID")
                conn.Execute strSQL
                Debug.Print "已更新ID: " & rsTarget("ID") ' 调试用，看更新了哪些行
            End If
            rsTarget.MoveNext
        End If
        rsSource.MoveNext
    Loop
    
    MsgBox "数据复制完成！"

Cleanup:
    ' 收尾：关闭所有对象，释放资源
    If Not rsSource Is Nothing Then rsSource.Close
    If Not rsTarget Is Nothing Then rsTarget.Close
    If Not conn Is Nothing Then conn.Close
    Set rsSource = Nothing: Set rsTarget = Nothing: Set conn = Nothing
    
    ' 出错提示
    If Err.Number <> 0 Then MsgBox "出错了: " & Err.Description, vbCritical
End Sub

' 辅助函数：把VBA值转成SQL能识别的格式，还能防SQL注入
Function GetSQLSafeValue(val As Variant) As String
    Select Case VarType(val)
        Case vbString: GetSQLSafeValue = "'" & Replace(val, "'", "''") & "'" ' 转义单引号
        Case vbDate: GetSQLSafeValue = "#" & Format(val, "yyyy-mm-dd hh:mm:ss") & "#"
        Case vbNull, vbEmpty: GetSQLSafeValue = "NULL"
        Case Else: GetSQLSafeValue = CStr(val) ' 数字直接转字符串
    End Select
End Function

几个重要的注意事项 #

• 修改你的表名和路径：把代码里的YourTableName改成你实际的表名，strDBPath改成你的.mdb文件路径
• 自定义条件：如果不是按Cat分组，或者源/目标行的条件不是Del=True/False，直接改两个SELECT语句里的WHERE子句就行
• 列范围调整：如果你的列顺序不是ID、Cat、Col1...Col40，就改For i = 3 To ...的起始数字，比如如果ID是第1列，Cat是第2列，那起始就是3，没错
• 先备份！：操作数据库前一定要备份.mdb文件，万一写错条件能恢复
• 调试技巧：可以先注释掉conn.Execute strSQL这一行，看Debug.Print输出的SQL语句对不对，确认没问题再执行

内容的提问来源于stack exchange，提问作者Chris Melville