Question

我有一个包含多个工作表的Excel文档。当我从第一张纸返回到第二张纸后运行循环跳转。但是在第二张表上没有打开一个新字典，我在ln 16时收到“运行时错误9”这样的错误。MySeries(Cnt, 2) = Dt(j, 2)

在新词典的开头，我可以为每张纸做些什么？

        Dim Cll As Object
        Dim j As Integer
        Dim y As Integer, MySeries, Dt, MySeries1, MySeries2, MySeries3, MySeries4 As Integer, sum As Double
        For y = 1 To (Worksheets.Count - 1)
        Sheets(y).Select
        Ln = Sheets(y).Range("a1").End(4).Row
        Sheets(y).Range("d2:H" & Ln).Interior.ColorIndex = xlNone
        Dt = Sheets(y).Range("d2:h" & Ln).Value
        Set Cll = CreateObject("Scripting.Dictionary")
        ReDim MySeries(1 To Ln, 1 To 5)
           For j = 1 To UBound(Dt, 1)
                Fnd = Dt(j, 1)
                If Not Cll.exists(Fnd) Then
                    Cnt = Cnt + 1
                    Cll.Add Fnd, Cnt
                    ReDim Preserve MySeries(1 To Ln, 1 To 5)
                     MySeries(Cnt, 1) = Dt(j, 1)
                     MySeries(Cnt, 2) = Dt(j, 2)
                     MySeries(Cnt, 3) = Dt(j, 3)
                     MySeries(Cnt, 4) = Dt(j, 4)
                End If
               MySeries(Cll.Item(Fnd), 5) = MySeries(Cll.Item(Fnd), 5) + Dt(j, 5) / 1000
            Next j
            Sheets(y).Range("a2:h" & Ln).Clear
            Sheets(y).Range("d2").Resize(Cll.Count, 5) = MySeries

        Next y

感谢您的帮助

Answer 1

cnt永远不会在此代码中的任何位置重置为0。虽然这可能是或者可能不是字典中项目的期望行为，但它导致cnt的值超出MySeries数组的边界（基于ln并获得在每张新表上重置。）

因此，如果ln第一张为20张而第二张为15张，则在第二张纸上添加第一张将与此相同：

Cnt = Cnt + 1 ' new value = 21
Cll.Add Fnd, Cnt ' should be OK
ReDim Preserve MySeries(1 To Ln, 1 To 5) ' MySeries is now (1 to 15, 1 to 5)
MySeries(Cnt, 1) = Dt(j, 1) ' MySeries(21, 1) exceeds the bounds of the array

目前尚不清楚为什么这会在MySeries(Cnt, 2) = Dt(j, 2)行失败，因为它应该在前一行失败 - MySeries(Cnt, 1) = Dt(j, 1)

根据{{3}}

编辑：，ReDim Preserve只能更改最终尺寸，以便将MySeries重新设置为（1到20,1到5）但仍然会失败，因为cnt超出了数组的界限

Answer 2

Redim Preserve只能更改二维数组的最上边界。原因与数据元素如何在内存中布局有关。请考虑以下数组声明：

Dim foo(1 to 4, 1 to 2)

在内存中，它看起来像这样：

现在采取以下声明：

ReDim Preserve foo(1 to 4, 1 to 3)

VBA运行时复制数据区并扩展其分配的内存以允许添加其他元素（如果第二维变小，则截断它）。新数据区域如下所示（蓝色新元素）：

请注意，通过指针偏移索引的方法保持不变。您仍会使用base_address + (index_one * index_two)返回相同的元素。

现在考虑这个陈述：

ReDim Preserve foo(1 to 5, 1 to 2)

它在内存中提供了以下布局（红色的新元素）：

请注意，没有一个连续的内存区域被保留。此外，一旦更改了第一个维度的边界，数组的索引更改 - base_address + (index_one * index_two)不再指向相同的元素。因此，除了最后一个维度之外，VBA不允许ReDim使用Preserve除了ReDim Preserve MySeries(1 To Ln, 1 To 5)之外的所有内容，并且会使有些神秘的＆＃34;下标超出范围＆＃34;错误。

因此，如果Ln的值发生变化，那么访问您的代码 - 行Preserve将始终失败。唯一的解决方法是在需要<img style="background-color:{@hexCode};" title="{@colourName}"/>时手动复制数组，或者擦除数组并从新数组开始。

设置dict = CreateObject（“Scripting.Dictionary”）循环，直到工作表

2 个答案: