在 Excel 表中更新大数据的最快方法

Question

我在 Excel 中有一个必须从 JSON 源更新的大表。 在解析 JSON 后，数据以字典的形式被提取并提供给我。 我正在遍历数据中的所有字段并更新表中的相关列。

Public Function GetFields(ByVal sApiEndpoint As String, ByVal sSheetName As String, ByVal sTableName As String)

    .........

    'Parse the Json Response and Update Table
    Dim dicParsed As Dictionary

    With ActiveWorkbook.Sheets(sSheetName).ListObjects(sTableName)

        Dim iCount As Integer

        iCount = 1

        Set dicParsed = JsonConverter.ParseJson(sRestResponse)

        For Each Item In dicParsed("data")

            iCount = iCount + 1

        Next Item

        If .ListRows.Count >= 1 Then
            .DataBodyRange.Delete
        End If

        Set Rng = .Range.Resize(iCount, .HeaderRowRange.Columns.Count)
        .Resize Rng

        Dim iRow As Integer
        iRow = 0

        For Each Item In dicParsed("data")

            On Error Resume Next


            .DataBodyRange.Cells(iRow, .ListColumns("name").Index) = Item("name")
            .DataBodyRange.Cells(iRow, .ListColumns("id").Index) = Item("id")
            .DataBodyRange.Cells(iRow, .ListColumns("type").Index) = Item("schema")("type")

            iRow = iRow + 1

        Next Item

    End With

    .........

End Function

在关闭计算和更新的情况下，更新 500 行 15 列的表大约需要 5 分钟。

在这种情况下有没有更快的方法来更新数据？

Answer 1

您可以将更新推送到数组，然后批量更新表。

1. 在不指定大小的情况下使任何类型的数组变暗。如果您有不同类型的列，例如数字和字符串，请使用 Variant。
2. 知道最终尺寸后重新调整数组。
3. 用数据更新数组。
4. 将表数据体设置为等于数组。

使用下面的代码，我能够将更新时间从 5 分钟缩短到不到 5 秒。

Public Function GetFields(ByVal sApiEndpoint As String, ByVal sSheetName As String, ByVal sTableName As String)

    .........

    'Parse the Json Response and Update Table
    Dim dicParsed As Dictionary

    With ActiveWorkbook.Sheets(sSheetName).ListObjects(sTableName)

        Dim iCount As Integer
        Dim arrDataBuffer() As Variant

        iCount = 1

        Set dicParsed = JsonConverter.ParseJson(sRestResponse)

        For Each Item In dicParsed("data")

            iCount = iCount + 1

        Next Item

        If .ListRows.Count >= 1 Then
            .DataBodyRange.Delete
        End If

        Set Rng = .Range.Resize(iCount, .HeaderRowRange.Columns.Count)
        .Resize Rng

        ReDim arrDataBuffer(iCount, .HeaderRowRange.Columns.Count)

        Dim iRow As Integer
        iRow = 0

        For Each Item In dicParsed("data")

            On Error Resume Next

            arrDataBuffer(iRow, .ListColumns("name").Index - 1) = Item("name")
            arrDataBuffer(iRow, .ListColumns("id").Index - 1) = Item("id")
            arrDataBuffer(iRow, .ListColumns("type").Index - 1) = Item("schema")("type")

            iRow = iRow + 1

        Next Item

        .DataBodyRange = arrDataBuffer

    End With

    .........

End Function