数组：比范围快

Question

我正在编写一个VB应用程序以连接到sap系统（使用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，检查其余代码，一切就好了。
我还没有创建一个有效的示例，所以我几次编辑了这段代码。仔细检查以免丢失数据。

VBA（RFC）SAP导出到Excel

1 个答案:

数组：比范围快