如何通过VBA和SQL动态引用Excel单元格日期实现查询更新？

你的核心问题是Excel日期的存储形式和SQL日期格式不匹配：直接拼接单元格Value到SQL语句时，Excel会把日期转换成序列号（比如22/12/22对应的数值是44917），SQL自然找不到匹配的数据。以下是修复方案：

关键修改点 #

把Excel单元格的日期转换成SQL能识别的字符串格式（比如'YYYY-MM-DD'），用Format函数即可实现格式转换。

修复后的完整代码 #

Option Explicit

Sub project()
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim SQL As String
    Dim server_name As String, database_name As String
    Dim targetDate As String
    
    ' 数据库连接信息
    server_name = "xxx"
    database_name = "xxx"
    
    ' 处理目标日期：转换成SQL兼容的格式
    If IsDate(ThisWorkbook.Sheets(1).Range("A1").Value) Then
        targetDate = Format(ThisWorkbook.Sheets(1).Range("A1").Value, "yyyy-mm-dd")
    Else
        MsgBox "A1单元格不是有效日期，请检查！"
        Exit Sub
    End If
    
    ' 初始化连接和记录集
    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    
    ' 构建SQL语句：使用转换后的日期字符串
    SQL = "SELECT * FROM table_name WHERE value_date = '" & targetDate & "'"
    
    On Error GoTo Cleanup ' 错误处理
    ' 执行查询
    cn.ConnectionString = "Provider=SQLNCLI11;Server=" & server_name & _
                          ";Database=" & database_name & ";Integrated Security=SSPI;"
    cn.Open
    rs.Open SQL, cn
    
    ' 清空Sheet2旧数据，避免残留
    ThisWorkbook.Sheets(2).Range("A2:Z" & ThisWorkbook.Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    ' 写入新数据
    ThisWorkbook.Sheets(2).Range("A2").CopyFromRecordset rs
    
Cleanup:
    ' 关闭连接，释放对象
    If Not rs Is Nothing Then
        If rs.State = adStateOpen Then rs.Close
        Set rs = Nothing
    End If
    If Not cn Is Nothing Then
        If cn.State = adStateOpen Then cn.Close
        Set cn = Nothing
    End If
    ' 如果有错误，提示
    If Err.Number <> 0 Then
        MsgBox "查询出错：" & Err.Description
    End If
End Sub

额外优化说明 #

• 增加日期有效性检查：如果A1不是有效日期，直接提示退出，避免SQL语法错误。
• 增加错误处理：连接失败、SQL执行出错时会提示，同时确保连接和记录集能正常关闭，避免资源泄漏。
• 增加旧数据清空：每次查询前清除Sheet2的旧数据，防止新旧数据混在一起。

为什么给单元格命名没用？ #

给单元格命名只是换了引用方式，本质还是取到Excel的日期序列号，没有解决格式转换的核心问题，所以仍然会失效。

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