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

I have an excel document that contains multiple sheets. When I run the loop Jumping after returning from the first sheet to the second sheet. But on the second sheet does not open a new dictionary and I get an error like "run time error 9" at ln 16. MySeries(Cnt, 2) = Dt(j, 2)

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

What can I do for each sheet in the opening of the new dictionary ?

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

        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

Thank you for your help

感谢您的帮助

2 个解决方案

#1

cnt never gets reset to 0 anywhere in this code. Whilst this may or may not be desired behaviour for the items in the dictionary, it leads to the value of cnt exceeding the bounds of the MySeries array (which is based on ln and gets reset on each new sheet).

cnt永远不会在此代码中的任何位置重置为0。虽然这可能是或者可能不是字典中项目的期望行为,但是它导致cnt的值超过MySeries数组的边界(其基于ln并且在每个新工作表上被重置)。

So, if ln was 20 for the first sheet and 15 for the second sheet, adding the first item on the second sheet will be equivalent to this:

因此,如果第一张纸的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

It's not clear why this would fail on the MySeries(Cnt, 2) = Dt(j, 2) line as it should fail on the previous line instead - MySeries(Cnt, 1) = Dt(j, 1)

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

edit: as per Comintern's answer, ReDim Preserve can only change the final dimension so MySeries would get redimensioned to (1 to 20, 1 to 5) but would still fail because cnt exceeds the bounds of the array

编辑:根据Comintern的回答,ReDim Preserve只能更改最终维度,因此MySeries会被重新定义为(1到20,1到5),但仍会失败,因为cnt超出了数组的范围

#2

Redim Preserve can only change the upper-most bound of a 2 dimensional array. The reason has to do with how the data elements are laid out in memory. Consider the following array declaration:

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

Dim foo(1 to 4, 1 to 2)

In memory, it looks like this:

在内存中,它看起来像这样:

Now take the following statement:

现在采取以下声明:

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

What happens is that the VBA runtime copies the data area and expands its allocated memory to allow adding additional elements (or truncates it if the 2nd dimension gets smaller). The new data area looks like this (new elements in blue):

会发生什么是VBA运行时复制数据区域并扩展其分配的内存以允许添加其他元素(如果第二维变小,则截断它)。新数据区看起来像这样(蓝色的新元素):

Notice that the method of indexing by pointer offset stays the same. You will still get the same elements back with base_address + (index_one * index_two).

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

Now consider this statement:

现在考虑这个陈述:

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

That gives the following layout in memory (new elements in red):

这在内存中提供了以下布局(红色的新元素):

Notice that there isn't a contiguous area of memory that is being preserved. Also, the indexing of the array changes - base_address + (index_one * index_two) no longer points at the same elements once you change the first dimension's bound. So, VBA disallows the ReDim with Preserve on everything except the last dimension and throws the somewhat cryptic "Subscript out of range" error.

请注意,没有保留的连续内存区域。此外,一旦更改了第一个维度的边界,数组的索引更改 - base_address +(index_one * index_two)不再指向相同的元素。因此,除了最后一个维度之外,VBA不允许ReDim和Preserve一起使用,并抛出有些神秘的“下标超出范围”错误。

So, getting to your code - the line ReDim Preserve MySeries(1 To Ln, 1 To 5) will always fail if the value of Ln changes. The only work-arounds are to manually copy the array if you need Preserve, or wipe the array and start with a fresh one.

因此,获取代码 - 如果Ln的值发生变化,ReDim Preserve MySeries(1到Ln,1到5)行将始终失败。如果您需要Preserve,则唯一的解决方法是手动复制阵列,或者擦除阵列并从新阵列开始。

#1