时间戳

首页 > 解决方案 > 从记录集粘贴到带有其他公式的表中无法执行任何操作

excel - 从记录集粘贴到带有其他公式的表中无法执行任何操作

问题描述

所以我有一个简短的代码片段：

Dim rs As ADODB.Recordset
If (m_db.OpenRs(rs, sql) = True) Then
    Call ClearIndivTable
    shReportIndiv.ListObjects("Tb_GL_Report_Indiv").DataBodyRange(1, 1).CopyFromRecordset rs
    rs.Close
End If

我期望发生的是在 rs 中找到的行会将自己粘贴到表格中。实际发生的事情并没有什么。

在与记录集大小完全相同的表上使用相同的属性会导致数据被粘贴。

 With table
        If Not .DataBodyRange Is Nothing Then
            .DataBodyRange.Delete
        End If

        If (m_db.OpenRs(rs, sql) = True) Then

            Set rng = shDefective.Range(table.Range.Cells(1).Address).Offset(1, 0)
            rng.CopyFromRecordset rs
        End If
    End With

此代码正在运行。我也尝试过使用偏移量，但这不起作用。我目前不怀疑这是问题所在。

使用相同的代码，但粘贴到一个范围内，会导致数据被粘贴。但是，我正在尝试粘贴到具有其他公式的表格中的单元格中，但它不起作用。

If (m_db.OpenRs(rs, sql) = True) Then
    pOutput.Range("A13").CopyFromRecordset rs
    rs.Close
End If

-更多工作代码示例

我确实希望有一天能够重构整个事情以使用 Excel 的本机工具……但那一天不是今天。

我基本上不知道如何将这些数据粘贴进去。

标签： excelvba

解决方案

我遇到了类似的问题并有一个解决方案：

'//BOILERPLATE CODE TO OUTPUT A RECORDSET TO A LISTOBJECT
Public Sub RecordsetToLo(ByRef lo As ListObject, ByRef rs As Recordset)
    
    '// checking that the recordset has returned data
    If rs.EOF And rs.BOF = True Then Exit Sub
    
    '// clear the existing data out of the listobject (lo)
    '// if omitted, old data would spill under the databodyrange of the object
    lo.DataBodyRange.Offset(1, 0).ClearContents
    
    '// for the formulae to drag down, no gap in the formulae column is allowed
    '// hence we must reduce the bodyrange to 1 row
    lo.Resize lo.Range.Resize(2)
    
    '// we may prepare a landing zone (LZ) to receive the new data
    '// but this step is optional since resizing the bodyrange to 1 row should
    '// achieve the same thing
    '    Dim LZ As Range: Set LZ = lo.Range.Resize(rs.RecordCount + 1)
    '    lo.Resize LZ

    '// Finally, we paste the data in the LO, the formulae should drag down
    lo.Range.Cells(2, 1).CopyFromRecordset rs

End Sub

没有评论：

Public Sub RecordsetToLo(ByRef lo As ListObject, ByRef rs As Recordset)
    If rs.EOF And rs.BOF = True Then Exit Sub
    lo.DataBodyRange.Offset(1, 0).ClearContents
    lo.Resize lo.Range.Resize(2)
    lo.Range.Cells(2, 1).CopyFromRecordset rs
End Sub

使用公式调整表格的大小非常昂贵并且可能需要时间。此版本仅在需要时调整大小，并且仅删除不超过记录集中字段数的单元格内容：

'//BOILERPLATE CODE TO OUTPUT A RECORDSET TO A LISTOBJECT
Public Sub rs_to_lo(ByRef lo As ListObject, ByRef rs As Recordset, Optional resize As Boolean = False)
    
    '// checking that the recordset has returned data
    If rs.EOF And rs.BOF = True Then Exit Sub
    lo.DataBodyRange.Offset(1, 0).resize(lo.ListRows.Count, rs.fields.Count).ClearContents
    If resize Then lo.resize lo.Range.resize(2)
    lo.Range.Cells(2, 1).CopyFromRecordset rs

End Sub

请注意，为了能够使用rs.RecordCount，我认为您需要打开一个服务器游标：

Optional cursorLocation As ADODB.CursorLocationEnum = adUseServer

推荐阅读