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

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

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

Answer 1

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

在不给出大小的情况下调暗任何类型的数组。如果您有不同类型的列，如数字和字符串，请使用Variant。
当您知道最终尺寸时重新调整数组。
使用数据更新数组。
将表格数据块设置为等于数组。

我可以使用以下代码将更新时间从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

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

1 个答案: