arrays - 如何确定 VBA 数组中子组的最大值

Question

我的歉意:下面的代码片段可能会导致我从工作表中工作的错误 - 我从工作表中获取代码中的值只是为了减轻代码的重量。 这些值来自 ADODB 数据集，然后复制到数组中。这些值将保留在内存中，并且不会使用任何工作表来获取最终结果。很抱歉没有从一开始就指定这一点。

我有一个二维数组，我正在尝试获取每个唯一 ID 的 MAX(VALUE)

<表类=“s-表”> <标题> ID 值 数据 <正文> 101 10 1125 101 8 2546 101 11 1889 102 5 3521 102 10 2254 103 11 3544

最终结果应该是具有唯一ID的finalArr:

<表类=“s-表”> <标题> ID 值 数据 <正文> 101 11 1889 102 10 2254 103 11 3544

到目前为止我所拥有的: 我确实设法找到了特定维度(值)的最大值

Sub MX_Value()
    Dim dataArr, iMax As Long, iCount As Long, tmpArr() As Integer, MyDim As Integer
    Dim i As Integer

        '*NOTE: Values from worksheet is an example only
        'in real-life the data comes from an ADODB dataset
        'so i need code that works in memory only.

        dataArr = ThisWorkbook.Sheets(1).[A1:C6].Value
        ReDim tmpAr(1 To UBound(dataArr))
        MyDim = 2 'Desired Dimension, 1 to 2
        For i = 1 To UBound(dataArr)
            tmpAr(i) = dataArr(i, MyDim)
        Next
        iMax = WorksheetFunction.Max(tmpAr)
        iCount = WorksheetFunction.Match(iMax, tmpAr, 0)
        MsgBox "MAX value is in dataArr(" & iCount & ") - with data: " & dataArr(iCount, 1) & " - " & dataArr(iCount, 2) & " - " & dataArr(iCount, 3)
End Sub

但我不知道如何对各个 ID 进行分组以找到它们的最大值。我能想到的唯一逻辑是:

1. 获取第一个 ID，然后将具有相同 ID 的所有行添加到 tempArr
2. 将 tempArr 发送到函数以获取 MAX 并将 MAX 行复制到 FinalArr
3. 转到与前一个 ID 不匹配的下一个 ID，然后重新开始... [???]

注意:在代码示例中，数据来自工作表，但只是为了简化代码。在实际应用程序中，数组中的数据来自 ADODB 数据集 - 因此一切都必须在内存中完成

任何见解将不胜感激!

Answer 1

您可以使用字典来跟踪最大值，请参阅下面的示例。

这是名为“Record”的类模块

Public id As Integer
Public value As Integer
Public data As Integer

这是我在工作表上连接的按钮单击的代码

Sub Button3_Click()
    Dim dict                   'Create a variable
    Set dict = CreateObject("Scripting.Dictionary")
    
    Dim dataArr() As Variant
    Dim id, value, data As Integer
    dataArr = Range("A2:C7").value
    Dim rec As Record
    
    For i = 1 To UBound(dataArr)
        id = dataArr(i, 1)
        value = dataArr(i, 2)
        data = dataArr(i, 3)
        
        If (dict.Exists(id)) Then
            Set rec = dict(id)
            ' if value is greater, then update it in dictionary for this id
            If (value > rec.value) Then
                dict.Remove (rec.id)
                Set rec = New Record
                rec.id = id
                rec.value = value
                rec.data = data
                dict.Add id, rec
            End If
        Else
            ' this is an id we haven't seen before, so add rec to dictionary
            Set rec = New Record
            rec.id = id
            rec.value = value
            rec.data = data
            dict.Add id, rec
        End If
    Next
    
    ' print results
    Dim result As String
    For Each id In dict.Keys()
        Set rec = dict(id)
        result = result & "id = " & id & ", maxValue = " & rec.value & ", data = " & rec.data & vbCrLf
    Next
    
    MsgBox (result)
    
End Sub