Tabela Excel traci formaty liczb, gdy dane są kopiowane z zestawu rekordów ADODB

Question

Aktualizuję tabelę excela z zestawu rekordów ADODB przy użyciu metody CopyFromRecordset.

Po aktualizacji liczby są wyświetlane jako daty, w których znajdują się kolumny liczbowe.

Dotychczasowe obejście polega na sformatowaniu kolumn z powrotem do liczb za pomocą VBA, ale nie jest to dobre rozwiązanie, ponieważ wykonanie tego raportu zajmuje więcej czasu. Muszę też napisać kod, aby pomieścić wiele stołów.

Czy jest szybka naprawa? Każda pomoc jest bardzo doceniana.

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

tblName - odnosi się do istniejącej tabeli, która odbyła się dane z tego samego formatu/typu danych jako dane RST

Answer 1

Poniżej przykładowy kod. Ilekroć proc getTableData nazywa się formatowanie kolumny & tabeli 1 zostanie zachowany zgodnie z zestawem rekordów. Mam nadzieję, że tego właśnie szukasz.

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 

Answer 2

Spróbuj - to kopie resultset do tablicy, transponuje je, a następnie kopiuje je do Excela

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 

Answer 3

wiem, że to późna odpowiedź, ale ja napotykają ten ten sam błąd. Myślę, że znalazłem obejście.

Wygląda na to, że Excel oczekuje, że zakres będzie górną lewą komórką, a nie zakresem komórek. Więc po prostu zmodyfikować oświadczenie 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 

Istnieje również wydaje się być wymóg, że arkusz docelowy jest aktywny, więc potęga muszą zapewnić arkusz jest aktywny, a potem wrócić do poprzednio aktywny arkusz. Mogło to zostać naprawione w późniejszej wersji programu Excel.