VBA执行SQL查询后粘贴数据丢失小数的问题排查与解决

原因分析 #

• Excel列格式预设问题：如果Sheet1的K列（对应查询返回的金额列）事先被设为整数格式，执行CopyFromRecordset时，Excel会自动把带小数的数值截断成整数，哪怕Recordset里的数值是完整的140000.35。
• ADODB数据映射异常：少数情况下，SQL返回的DECIMAL/NUMERIC类型字段，在ADODB与Excel的类型映射中可能丢失小数精度，但这种情况概率低，优先排查列格式问题。
• 代码Range引用隐患：原代码里Range("A3").CopyFromRecordset rs没指定工作表，默认用当前活动表，虽然和小数丢失无关，但容易导致数据贴错位置。

解决办法 #

1. 提前设置目标列数值格式（推荐） #

在粘贴数据前，先把Sheet1的K列（或者所有数据列）设置为带小数的数值格式，确保Excel能正确存储和显示小数。修改代码中的粘贴部分：

' Paste output into Excel worksheet
With ThisWorkbook.Sheets("Sheet1")
    ' 把第11列（K列）设置为保留2位小数的数值格式，适配金额需求
    .Columns(11).NumberFormat = "0.00"
    ' 也可以给所有数据列设置通用格式，避免其他列出类似问题
    '.Range("A3:Z6000").NumberFormat = "General"
    
    ' 写入列名
    For i = 0 To rs.Fields.Count - 1
        .Cells(2, i + 1).Value = rs.Fields(i).Name
    Next
    ' 明确指定工作表的Range，避免贴错位置
    .Range("A3").CopyFromRecordset rs
End With

2. 检查SQL查询的字段类型 #

确认你的SQL语句里，金额字段没有被误转成整数类型。比如不要用CAST(金额字段 AS INT)这类截断操作，保证字段类型是DECIMAL(18,2)或其他带小数精度的类型。

3. 手动遍历Recordset赋值（备用） #

如果CopyFromRecordset的自动映射还是有问题，可以放弃批量粘贴，手动逐行逐列赋值，确保数值完整写入：

' 替换原粘贴部分的代码
With ThisWorkbook.Sheets("Sheet1")
    ' 写入列名
    For i = 0 To rs.Fields.Count - 1
        .Cells(2, i + 1).Value = rs.Fields(i).Name
    Next
    
    ' 手动遍历Recordset赋值
    Dim rowNum As Long
    rowNum = 3
    Do While Not rs.EOF
        For i = 0 To rs.Fields.Count - 1
            .Cells(rowNum, i + 1).Value = rs.Fields(i).Value
        Next
        rs.MoveNext
        rowNum = rowNum + 1
    Loop
End With

额外代码优化 #

原代码中Range("A3").CopyFromRecordset rs未指定工作表，容易因当前活动表不是Sheet1导致数据贴错，建议始终用.Range（带With块前缀）明确引用目标工作表。

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