vba 从 ADODB 记录集复制数据时，Excel 表丢失数字格式
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16070313/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel table loses number formats when data is copied from ADODB recordset
提问by flungu
I'm updating an excel table from an ADODBrecordset using the CopyFromRecordsetmethod.
我正在使用该方法从ADODB记录集更新 excel 表CopyFromRecordset。
After the update, the numbers show up as dates wherever there are number columns.
更新后，只要有数字列，数字就会显示为日期。
The workaround I used until now is to format the columns back to numbers through VBA, but it's not a good solution as takes more time for the report to complete. Also I have to write code to accommodate a lot of tables.
到目前为止，我使用的解决方法是通过VBA将列格式化回数字，但这不是一个好的解决方案，因为完成报告需要更多时间。此外，我必须编写代码以容纳大量表格。
Is there a quick fix? Any help is greatly appreciated.
有快速修复吗？任何帮助是极大的赞赏。
'Delete old data and copy the recordset to the table
Me.ListObjects(tblName).DataBodyRange.ClearContents
Me.Range(tblName).CopyFromRecordset rst
tblName- refers to an existing table that held data of the same format/datatype as rst data
tblName- 引用与第一个数据具有相同格式/数据类型的数据的现有表
回答by ThunderFrame
I know this is a late answer, but I was encountering this same error. I think I've found a workaround.
我知道这是一个迟到的答案，但我遇到了同样的错误。我想我已经找到了解决方法。
It seems Excel expects the range to be the top-left cell rather than a range of cells. So just modify your statement to Range(tblName).Cells(1,1).CopyFromRecordset rst
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
There also seems to be a requirement that the target sheet be active, so you mighthave to ensure the sheet is active first, and then change back to the previously active sheet. This might have been fixed in later version of Excel.
似乎还要求目标工作表处于活动状态，因此您可能必须先确保工作表处于活动状态，然后再更改回以前的活动工作表。这可能已在更高版本的 Excel 中修复。
回答by Sriketan Mahanti
Try this - this copies resultset into a array, transposes it and then copies it into excel
试试这个 - 这将结果集复制到一个数组中，将其转置，然后将其复制到 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
回答by Santosh
Below is sample code. Whenever the proc getTableData is called the formatting & column format of the table1 will be retained according to the recordset. I hope this is what you are looking for.
下面是示例代码。每当调用 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
回答by Spring Filip
After reading through forums posts of other people who encountered the same problem, here are all the options I know of (some of them already mentioned in other answers):
在阅读了遇到相同问题的其他人的论坛帖子后，以下是我所知道的所有选项（其中一些已在其他答案中提到）：
- Insert only into the first cell of the target range - see @ThunderFrame's answer.
- Activate worksheet that contains target range on the line above
CopyFromRecordset() Turn off automatic recalculation:
Application.Calculation = xlCalculationManual .CopyFromRecordset rs Application.Calculation = xlCalculationAutomatic
- 仅插入目标范围的第一个单元格 - 请参阅@ThunderFrame 的答案。
- 激活包含上一行目标范围的工作表
CopyFromRecordset() 关闭自动重新计算：
Application.Calculation = xlCalculationManual .CopyFromRecordset rs Application.Calculation = xlCalculationAutomatic
Workarounds:
解决方法：
- Iterate rows/columns and insert values one at a time - @Sriketan's answer provides code for this one. Another code snippets are in the links below.
- Paste into temporary workbook and then copy it from there.
- 迭代行/列并一次插入一个值 - @Sriketan 的回答提供了这一点的代码。另一个代码片段在下面的链接中。
- 粘贴到临时工作簿中，然后从那里复制。
Sources:
资料来源：
- Duchgemini's post and discussion: https://dutchgemini.wordpress.com/2011/04/21/two-serious-flaws-with-excels-copyfromrecordset-method/
- Microsoft's forum: 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
- 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 ?论坛=exceldev
