多维数组，用于存储和计数唯一ID的出现

Question

背景：

为了更好地理解动态多维数组，我试图构建一个数组以捕获唯一值并计算唯一值的出现次数（我应该能够使用countif迅速验证这一点）。

在阅读有关尝试重新保存多维数组的imim时，我读到只能重新对最后一个参数进行imim，因此我尝试设置2个参数，其中第一个是唯一值，第二个是count：arr （2，k）。如果我的理解是错误的，那也很重要。

我将把数组的最终输出放入第3列（唯一ID）和第4列（出现次数）中。

---

问题：

将值添加到数组时，我无法收集所有唯一值。当数据中有6个值，并且每个值的出现都保持为1时（例如不进行迭代），我已经能够收集3个唯一值。

---

题：

我很抱歉这实际上是2个问题...

• 1）我对redim保存器arr（2,0到k）的使用是否合适？

• 2）我的动态数组生成是否存在明显问题，这可以解释为什么我没有捕获所有唯一值？

我可能会问三分之一关于为什么我无法使发生次数起作用的原因，但是我希望，如果我理解了上述问题，我有望在这一部分中奋斗。

---

数据如下所示：

所有数据均在A列中

cat
dog
mouse
cat
mouse
bear
frog
cat
moose
cat
dog

---

有问题的代码：

Option Explicit

Private Sub unique_arr()
    Dim arr As Variant, i As Long, lr As Long, k As Long
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    ReDim arr(2, k)
    For i = 1 To lr
        If Application.IfError(Application.Match(Cells(i, 1).Value, arr, 0), 0) = 0 Then
            ReDim Preserve arr(2, 0 To k)
            arr(1, k) = Cells(i, 1).Value
            arr(2, k) = 1
            k = k + 1
        Else
            arr(2, Application.Match(Cells(i, 1), arr(1), 0)) = arr(2, Application.Match(Cells(i, 1), arr(1), 0)) + 1
        End If
    Next i
    For i = LBound(arr) To UBound(arr)
        Cells(i + 1, 3).Value = arr(1, i)
        Cells(i + 1, 4).Value = arr(2, i)
    Next i
End Sub

Answer 1

虽然使用字典可以使整体效果更好，但是If比较存在一些问题。

If Application.IfError(Application.Match(Cells(i, 1).Value, arr, 0), 0) = 0 Then

VBA有其自己的IsError，它返回True / False。

If IsError(Application.Match(Cells(i, 1).Value, arr, 0), 0)) Then

另外，arr是二维数组；本质上，它既有行又有列。工作表的“匹配”只能在单列或单行上工作。您需要通过“索引”来“分割”您想要的内容。

If Not IsError(Application.Match(Cells(i, 1).Value, application.index(arr, 1, 0), 0), 0)) Then

最后，将arr定义为ReDim arr(2, k)。这样一arr(0 to 2, 0 to k)来，第一个等级中就有3个元素（0，1，2），而不是2。您实际上从未在第一等级中实际使用0。它应该是，

k = 1
ReDim arr(1 to 2, 1 to k)

将其全部缠绕起来，最终会得到类似这样的结果。

Option Explicit

Private Sub unique_arr()
    Dim i As Long, lr As Long, k As Long, arr As Variant, m As Variant

    'assign values to some vars
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    k = 1
    ReDim arr(1 To 2, 1 To k)

    'loop through cells, finding duplicates and counting
    For i = 1 To lr
        m = Application.Match(Cells(i, 1).Value, Application.Index(arr, 1, 0), 0)
        If IsError(m) Then
            ReDim Preserve arr(1 To 2, 1 To k)
            arr(1, k) = Cells(i, 1).Value
            arr(2, k) = 1
            k = k + 1
        Else
            arr(2, m) = arr(2, m) + 1
        End If
    Next i

    'loop through array's second rank
    For i = LBound(arr, 2) To UBound(arr, 2)
        Cells(i, 3).Value = arr(1, i)
        Cells(i, 4).Value = arr(2, i)
    Next i

End Sub