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

时间:2013-04-17 21:08:54

标签: excel vba excel-vba adodb

我正在使用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 - 指的是保存与第一个数据格式/数据类型相同的数据的现有表

4 个答案:

答案 0 :(得分: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

答案 1 :(得分:2)

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

似乎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中修复。

答案 2 :(得分:1)

以下是示例代码。每当调用proc getTableData时,格式化& table1的列格式将根据记录集保留。我希望这就是你要找的东西。

 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

enter image description here

答案 3 :(得分:0)

在阅读了遇到相同问题的其他人的论坛帖子后,以下是我所知道的所有选项(其中一些已经在其他答案中提到):

  1. 仅插入目标范围的第一个单元格-请参阅@ThunderFrame的答案。
  2. 激活在CopyFromRecordset()上方的行中包含目标范围的工作表
  3. 关闭自动重新计算:

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

解决方法:

  1. 迭代行/列并一次插入一个值-@Sriketan的答案为此提供了代码。其他代码段在下面的链接中。
  2. 粘贴到临时工作簿中,然后从那里复制它。

来源:

  1. Duchgemini的帖子和讨论:https://dutchgemini.wordpress.com/2011/04/21/two-serious-flaws-with-excels-copyfromrecordset-method/
  2. Microsoft的论坛: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
相关问题