VBA (RFC) SAP 导出到 excel

Question

我正在编写一个用于连接到 sap 系统的 VB 应用程序（使用 rfc）。 一切正常，我也获得了连接和数据。

尽管如此，保存访问数据并将其写入excel文件的代码确实很慢。

连接后我调用 RFC_READ_TABLE，它在 <5 秒内返回结果，这是完美的。 写入 excel（逐个单元格）非常慢。 有什么方法可以将整个 tblData '导出' 到 excel 并且不依赖于逐个单元地写入？

提前致谢！

If RFC_READ_TABLE.Call = True Then
    MsgBox tblData.RowCount
    If tblData.RowCount > 0 Then

        ' Write table header
        For j = 1 To Size
            Cells(1, j).Value = ColumnNames(j)
        Next j

        Size = UBound(ColumnNames, 1) - LBound(ColumnNames, 1) + 1

        For i = 1 To tblData.RowCount
            DoEvents
            Textzeile = tblData(i, "WA")

            For j = 1 To Size
                Cells(i + 1, j).Value = LTrim(RTrim(getPieceOfTextzeile(Textzeile)))
            Next j

       Next
    Else
       MsgBox "No entries found in system " & SYSID, vbInformation
    End If

Else
   MsgBox "ERROR CALLING SAP REMOTE FUNCTION CALL"
End If

Answer 1

数组：比范围更快

如果数据准备好（不需要处理），这样的事情可能是一个解决方案：

Sub Sap()

    Const cStrStart As String = "A1" 'First cell of the resulting data

    Dim tbldata
    Dim arrSap As Variant 'Will become a one-based two dimensional array
    Dim oRng As Range

        arrSap = tbldata 'Data is in the array.

        'Calculate the range: Must be the same size as arrSap
        Set oRng = Range(Cells(Range(cStrStart).Row, UBound(arrSap)), _
            Cells(Range(cStrStart)).Column, UBound(arrSap, 2))

        oRng = arrSap 'Paste array into range.

End Sub

由于您需要从 tbldata 处理您的数据，因此您不需要对范围执行任何操作，而是处理应该更快的数组：

Sub Sap()

    Const cStrStart As String = "A1" 'First cell of the resulting data

    Dim arrSap() As Variant
    Dim oRng As Range
    Dim Size As Integer

    If RFC_READ_TABLE.Call = True Then
'-------------------------------------------------------------------------------
        MsgBox tbldata.RowCount
        If tbldata.RowCount > 0 Then
            Size = UBound(ColumnNames, 1) - LBound(ColumnNames, 1) + 1
            ReDim arrSap(1 To tbldata.RowCount + 1, 1 To Size) '+ 1 for header
            ' Write table header
            For j = 1 To Size
                arrSap(1, j).Value = ColumnNames(j)
            Next j
            ' Write data
            For i = 1 + 1 To tbldata.RowCount + 1 '+ 1 for header
                DoEvents
                '- 1 due to header, don't know what "WA" is
                Textzeile = tbldata(i - 1, "WA")
                For j = 1 To Size
                    arrSap(i, j) = _
                        LTrim(RTrim(getPieceOfTextzeile(Textzeile)))
                Next j
            Next
'-------------------------------------------------------------------------------
            'Calculate the range: Must be the same size as arrSap
            Set oRng = Range(Cells(Range(cStrStart).Row, Range(cStrStart).Column), _
                Cells(UBound(arrSap) + Range(cStrStart).Row -1, _
                UBound(arrSap, 2) + Range(cStrStart).Column -1))
            oRng = arrSap
'-------------------------------------------------------------------------------
        Else
            MsgBox "No entries found in system " & SYSID, vbInformation
        End If
    Else
        MsgBox "ERROR CALLING SAP REMOTE FUNCTION CALL"
    End If

End Sub

现在调整 cStrStart，检查其余的代码，你就可以开始了。
我还没有创建一个工作示例，所以我编辑了几次这段代码。 仔细检查以免丢失数据。