如何確定VBA陣列中子組的MAX值

我的道歉：下面的代碼片段可能會錯誤地導致我從作業表中作業 - 我從作業表中獲取代碼中的值只是為了減輕代碼。VALUES 來自 ADODB 資料集，然后將其復制到陣列中。這些值將保留在記憶體中，并且不使用任何作業表來獲得最終結果。很抱歉沒有從一開始就指定這個。

我有一個二維陣列，我正在嘗試獲取每個唯一 ID 的 MAX(VALUE)

最終結果應該是具有唯一 ID 的 finalArr：

到目前為止我所擁有的：我確實設法在特定維度（值）中找到了 MAX

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 進行分組以找到它們的 MAX。我能想出的唯一邏輯是：

1. 獲取第一個 ID，然后將具有相同 ID 的所有行添加到 tempArr
2. 將 tempArr 發送到函式以獲取 MAX 并將 MAX 行復制到 finalArr
3. 轉到下一個與前一個不匹配的 ID 并重新開始... [???]

注意：在代碼示例中，資料來自作業表，但只是為了簡化代碼。在它的實際應用程式中，陣列中的資料來自 ADODB 資料集 - 所以一切都必須在記憶體中完成

任何見解將不勝感激！

uj5u.com熱心網友回復：

您可以使用字典來跟蹤最大值，請參見下面的示例。

這是名為“記錄”的類模塊

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

uj5u.com熱心網友回復：

獲取每個唯一值的最大值

• 字典將唯一值作為它的key，并將最高值的行作為對應的item。在回圈時，它將使用此項來比較第 2 列的值并進行相應的修改。最后，另一個回圈會將結果寫入同一陣列，該陣列將部分復制到目標范圍。
• 假設有一行標題。如果您不想要標題，則在sfcAddress必要時更改并更改For r = 1 to srCountand r = 0。

Option Explicit

Sub MaxOfUnique()
    
    Const sName As String = "Sheet1"
    Const sfcAddress As String = "A1"
    
    Const dName As String = "Sheet1"
    Const dfcAddress As String = "E1"
    
    Const cCount As Long = 3
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim sfCell As Range: Set sfCell = sws.Range(sfcAddress)
    Dim srg As Range
    With sfCell.CurrentRegion
        Set srg = sfCell.Resize(.Row   .Rows.Count _
            - sfCell.Row, .Column   .Columns.Count - sfCell.Column)
    End With
    Dim srCount As Long: srCount = srg.Rows.Count
    If srCount < 2 Then Exit Sub
    
    Dim Data As Variant: Data = srg.Value
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim r As Long
    
    For r = 2 To srCount
        If dict.Exists(Data(r, 1)) Then
            If Data(r, 2) > Data(dict(Data(r, 1)), 2) Then
                dict(Data(r, 1)) = r
            End If
        Else
            dict(Data(r, 1)) = r
        End If
    Next r
    
    Dim Key As Variant
    
    r = 1
    For Each Key In dict.Keys
        r = r   1
        Data(r, 1) = Key
        Data(r, 2) = Data(dict(Key), 2)
        Data(r, 3) = Data(dict(Key), 3)
    Next Key
    
    With wb.Worksheets(dName).Range(dfcAddress).Resize(, cCount)
        .Resize(r).Value = Data ' write
        .Resize(.Worksheet.Rows.Count - .Row - r   1).Offset(r).Clear ' below
    End With
    
End Sub

標籤：数组 擅长 vba 最大限度

上一篇：如何使輸出“否定！”在console.log(question4([-1,4,7,11]))

下一篇：當我不操作它時，為什么這個陣列會發生變化？