根据唯一值和赋值转换 11*2 数组

Question

我需要一个函数，它接受一个 n*2 输入数组并生成 n*2 输出数组，它的第一列元素是输入数组第一列的唯一值，第二列元素是对应于这些唯一值的数字的总和价值观。

Sub test()
Dim arm(11, 1) As Variant
Dim tempar() As Variant
ReDim tempar(0 To UBound(arm, 1), 0 To UBound(arm, 2)) As Variant

arm(0, 0) = "banana"
arm(1, 0) = "banana"
arm(2, 0) = "banana"
arm(3, 0) = "apple"
arm(4, 0) = "apple"
arm(5, 0) = "banana"
arm(6, 0) = "cucumber"
arm(7, 0) = "cucumber"
arm(8, 0) = "cucumber"
arm(9, 0) = "apple"
arm(10, 0) = "cucumber"
arm(11, 0) = "a"

arm(0, 1) = 5
arm(1, 1) = 4
arm(2, 1) = 3
arm(3, 1) = 2
arm(4, 1) = 5
arm(5, 1) = 3
arm(6, 1) = 2
arm(7, 1) = 4
arm(8, 1) = 5
arm(9, 1) = 1
arm(10, 1) = 1
arm(11, 1) = 3

tempar() = unqfiladv(arm)

End Sub  

结果数组必须是：

香蕉 15
苹果 8
黄瓜 12
一个 3

Answer 1

这是我所描述的一个例子。

循环第一个数组并将水果和值添加到字典中。这将确保唯一的水果名称，用作键，并且可以通过简单地添加到现有值来添加值，如果键（水果）已经存在于字典中，否则以正常方式添加。

转置数组以允许交换维度（因为您只能调整第二个维度的大小。使用 Transpose 可以执行的项目数量有限制）。

您应该真正将其分离为单独的函数/过程调用，例如，将项目添加到字典可能是它自己的函数。字典键值的检索按照@Peter Albert.

Option Explicit

Sub Test()

Dim arr1(0 to 5, 0 to 1)
Dim arr2()

arr1(0,0) = "Banana"
arr1(1,0) = "Banana"
arr1(2,0) = "Apple"
arr1(3,0) = "Banana"
arr1(4,0) = "Orange"
arr1(5,0) = "Orange"

arr1(0,1) = 1
arr1(1,1) = 2
arr1(2,1) = 3
arr1(3,1) = 4
arr1(4,1) = 5
arr1(5,1) = 6

Dim fruitDict As New Scripting.Dictionary 'required reference to MS Scripting Runtime

Dim i as Long

For i = LBound(arr1,1) to UBound(arr1,1)

    If fruitDict.Exists(arr1(i,0)) Then

        fruitDict(arr1(i,0)) = fruitDict(arr1(i,0)) + arr1(i,1)

    Else

       fruitDict.Add arr1(i,0) , arr1(i,1)

    End If

Next i

ReDim arr2(0 to 1, 0 to FruitDict.Count - 1)

arr2 = Application.WorksheetFunction.Transpose(arr2)

Dim key As Variant
Dim counter As Long
counter = 1

For Each key in fruitDict.Keys

    arr2(counter,1) = key
    arr2(counter,2) = fruitDict(key)
    counter = counter + 1

Next key

End Sub