VBA (RFC) SAP导出到excel

Question

我正在编写一个VB应用程序来连接到sap系统(使用rfc)。一切都很好，我确实得到了连接和数据。

不过，保存已访问的数据并将其写入excel文件的代码非常慢。

在连接之后，我调用RFC_READ_TABLE，它返回的结果为<5秒，这是完美的。写到excel (逐个单元格)是相当缓慢的。是否有任何方法可以“导出”整个tblData，使其不依赖于逐个单元格的写入？

提前感谢！

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，检查剩下的代码，您就可以开始了。

我还没有创建一个工作示例，所以我编辑了这段代码几次。仔细检查，以免丢失数据。