从 ADODB 记录集中复制数据时 Excel 表丢失数字格式答案

【问题标题】：Excel table loses number formats when data is copied from ADODB recordset从 ADODB 记录集中复制数据时 Excel 表丢失数字格式
【发布时间】：2013-04-10 19:43:24
【问题描述】：

我正在使用CopyFromRecordset 方法从ADODB 记录集中更新一个excel 表。

更新后，只要有数字列，数字就会显示为日期。

到目前为止，我使用的解决方法是通过 VBA 将列格式化回数字，但这不是一个好的解决方案，因为报告需要更多时间才能完成。我还必须编写代码来容纳很多表。

有没有快速解决办法？非常感谢任何帮助。

'Delete old data and copy the recordset to the table
Me.ListObjects(tblName).DataBodyRange.ClearContents
Me.Range(tblName).CopyFromRecordset rst

tblName - 指一个现有的表，该表包含与第一个数据相同格式/数据类型的数据

【问题讨论】：

在使用CopyFromRecordset 导出数据之前尝试此Me.Range(tblName).Columns(1).Numberformat = "0" 其中1 例如是存储数字的相关列。
我目前正在对数据导入后的每个数字列（或可能的列范围）执行此操作。在导入之前这样做只会改变时间，但不能解决问题。我仍然需要编写代码来修复每个表中的每个数字列。我希望表格保持导入前的格式。
ADODB 记录集中没有“格式”，只有数据类型。您可以更改代码以根据列 ADODB 数据类型自动设置 Excel 格式，但 ADODB 数据集中没有固有的格式 - 查看其中的所有属性。
@ElectricLlama “格式”是指现有 Excel 表中的列格式。我指的不是 ADODB 记录集中字段的数据类型。例如，在执行 copyFromRecordset 后，excel 表中数字格式的列变成日期格式的列。

标签： vba excel adodb

【解决方案1】：

以下是示例代码。每当调用 proc getTableData 时，table1 的格式和列格式将根据记录集保留。我希望这就是您正在寻找的。p>

 Sub getTableData()

    Dim rs As ADODB.Recordset
    Set rs = getRecordset

    Range("A1").CurrentRegion.Clear
    Range("A1").CopyFromRecordset rs
    Sheets("Sheet1").ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlNo).Name = "Table1"

End Sub



Function getRecordset() As ADODB.Recordset

    Dim rsContacts As ADODB.Recordset
    Set rsContacts = New ADODB.Recordset

    With rsContacts
        .Fields.Append "P_Name", adVarChar, 50
        .Fields.Append "ContactID", adInteger
        .Fields.Append "Sales", adDouble
        .Fields.Append "DOB", adDate
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic

        .Open

        For i = 1 To WorksheetFunction.RandBetween(3, 5)
             .AddNew
            !P_Name = "Santosh"
            !ContactID = 2123456 * i
            !Sales = 10000000 * i
            !DOB = #4/1/2013#
            .Update
        Next

        rsContacts.MoveFirst
    End With

    Set getRecordset = rsContacts
End Function

【讨论】：

感谢您的示例代码。但是我有引用我的表的公式，所以我不能删除表（你的Range("A1").CurrentRegion.Clear 完全删除了表）。我必须重复使用这些表格，否则我的所有公式都会有 '#REF!' 错误。在我清除旧数据表 (Me.ListObjects(tblName).DataBodyRange.ClearContents) 并将新数据从记录集中复制回同一个表 (Me.Range(tblName).CopyFromRecordset rst) 后，会出现数字格式化为日期的问题。

【解决方案2】：

试试这个 - 这会将结果集复制到一个数组中，将其转置，然后将其复制到 excel 中

Dim rs As New ADODB.Recordset

Dim targetRange As Excel.Range

Dim vDat As Variant

' Set rs

' Set targetRange   

rs.MoveFirst

vDat = Transpose(rs.GetRows)

targetRange.Value = vDat


Function Transpose(v As Variant) As Variant
    Dim X As Long, Y As Long
    Dim tempArray As Variant

    ReDim tempArray(LBound(v, 2) To UBound(v, 2), LBound(v, 1) To UBound(v, 1))
    For X = LBound(v, 2) To UBound(v, 2)
        For Y = LBound(v, 1) To UBound(v, 1)
            tempArray(X, Y) = v(Y, X)
        Next Y
    Next X

    Transpose = tempArray

End Function

【讨论】：

【解决方案3】：

我知道这是一个迟到的答案，但我遇到了同样的错误。我想我找到了解决方法。

似乎 Excel 期望范围是左上角的单元格，而不是单元格范围。所以只需将您的声明修改为Range(tblName).Cells(1,1).CopyFromRecordset rst

'Delete old data and copy the recordset to the table
Me.ListObjects(tblName).DataBodyRange.ClearContents
Me.Range(tblName).Cells(1,1).CopyFromRecordset rst

似乎还要求目标工作表处于活动状态，因此您可能必须先确保工作表处于活动状态，然后再更改回之前的活动工作表。这可能已在更高版本的 Excel 中得到修复。

【讨论】：

.Cells(1, 1) 是一个很好的解决方案！作品

【解决方案4】：

在阅读了遇到同样问题的其他人的论坛帖子后，以下是我所知道的所有选项（其中一些已经在其他答案中提到）：

仅插入目标范围的第一个单元格 - 请参阅@ThunderFrame 的答案。
在CopyFromRecordset() 上方的行中激活包含目标范围的工作表

关闭自动重新计算：

Application.Calculation = xlCalculationManual
.CopyFromRecordset rs
Application.Calculation = xlCalculationAutomatic

解决方法：

迭代行/列并一次插入一个值 - @Sriketan 的答案提供了此代码。另一个代码 sn-ps 在下面的链接中。
粘贴到临时工作簿中，然后从那里复制。

来源：

Duchgemini 的帖子和讨论：https://dutchgemini.wordpress.com/2011/04/21/two-serious-flaws-with-excels-copyfromrecordset-method/
微软论坛：https://social.msdn.microsoft.com/Forums/office/en-US/129c0a52-4ccb-4f54-9e38-8c0ae6e300b1/copyfromrecordset-corrupts-cell-formats-for-the-whole-excel-workbook?forum=exceldev

【讨论】：