vba array - 处理超出数组保留维度的条件

Question

我想遍历我的 table，将值存储到数组 LotN() 中（图中有 2 个单独的样本数据集，以说明我可能会遇到不同的数字唯一批号）（屏幕截图仅供参考。数据实际上存储在二维数组 A1() 中）。

candidate = "blah"     

' loop through records, add to arrays  (skip adding duplicated values with the function IsInArray = false)       
For i = 2 To LR
    If .Cells(i, 5).Value = candidate And IsInArray(.Cells(i, 2).Value, lotN) = False Then
        q = q + 1
        lotN(q) = .Cells(i, 2).Value
    End If
Next i
        
Debug.Print "q = " & q ' try to know how many records were thrown into the arrays
        
ReDim Preserve lotN(1 To q)

通常我的数据q等于1到3，但我必须准备q到6，以用于下面的程序。我需要的下一步是计算另一个数组 A1() 中与 LotN() 中的每个元素匹配的元素数。

' use counter to check the number of data pieces from another array A1() matching the elements within the array LotN()
For k = 1 To r
    If A1(k, 2) = lotN(1) And lotN(1) <> "" Then
        c = c + 1
    End If
    If A1(k, 2) = lotN(2) And lotN(2) <> "" Then
        d = d + 1
    End If
    If A1(k, 2) = lotN(3) And lotN(3) <> "" Then ' with q = 2, the code stopped at this line with error "script out of range"
        e = e + 1
    End If
    If A1(k, 2) = lotN(4) And lotN(4) <> "" Then
        f = f + 1
    End If
    If A1(k, 2) = lotN(5) And lotN(5) <> "" Then
        g = g + 1
    End If
    If A1(k, 2) = lotN(6) And lotN(6) <> "" Then
        h = h + 1
    End If
    
Next k

我想为数组中的每个元素创建计数器（上面几行中的 c、d、e、f、g、h）。由于我不确定 q 究竟等于多少，我的尝试是使用 lotN（该数组中元素的位置）<> "" 来允许计数器递增。但是，这不起作用。当 q = 2 时，指示处或下方的行仍会导致错误“脚本超出范围”。

我该如何处理这个错误？

Answer 1

由于数组的大小是可变的，我建议您不要遍历设定范围，而是遍历数组本身。

counter = 0

For Each itm in lotN
    counter = counter + 1
    
    If A1(counter, 2) = itm Then
        If counter = 1 Then
            c = c + 1
        ElseIf counter = 2 Then
            d = d + 1
        ElseIf counter = 3 Then
            e = e + 1
        ElseIf counter = 4 Then
            f = f + 1
        ElseIf counter = 5 Then
            g = g + 1
        ElseIf counter = 6 Then
            h = h + 1
        End If
    End If
Next itm

Answer 2

为此，您需要 tools-References 下的 Microsoft Scripting Runtime 库。

这是注释的代码：

Option Explicit
Const Candidate As String = "blah"
Sub Test()
    
    'Here we will store the Candidates to enum
    Dim Candidates As Dictionary: Set Candidates = LoadCandidates
    'Another dictionary to hold the candidates on the array
    Dim lotN As Dictionary: Set lotN = New Dictionary
    For K = 1 To r
        'If the value is in the Candidates Dictionary then
        If Candidates.Exists(A1(K, 2)) Then
            'If the Candidate is in the lotN already, add 1
            If lotN.Exists(A1(K, 2)) Then
                lotN(A1(K, 2)) = lotN(A1(K, 2)) + 1
            'If not, add the candidate to the lotN and equal it to 1
            Else
                lotN.Add A1(K, 2), 1
            End If
            'output the number of times the candidate has appeared
            A1(K, 7) = lotN(A1(K, 2))
        End If
    Next K


End Sub
Private Function LoadCandidates() As Dictionary
    
    Set LoadCandidates = New Dictionary
    For i = 2 To LR
        If Cells(i, 5) = Candidate And Not LoadCandidates.Exists(Cells(i, 2).Value) Then
            LoadCandidates.Add Cells(i, 2).Value, 1
        End If
    Next i

End

P.S.: 修改代码以满足您的需要，因为您没有 post 引用单元格的工作表和工作簿并提供 A1 数组所需的整个代码。 .

vba array - 处理超出数组保留维度的条件

vba array - handle conditions outside the preserved dimension of an array

arrays

vba

counter