求助VBA大神：当一列值相同，求对应另一列的最大值

Curry_Chen

求助：在sheet1里，当B列值相同时，求对应C列的最大值，并将对应行依次输入到sheet2中

例如：B列中名称为A1的，对应最大值为24，但是有2行都为24，需要的结果是A列时间点数大的那一行的值，也就是17点那一行，万分感谢！！

ykcbf1100

是这样吗？

蓝桥玄霜

最大值的例子：

chumi

VB确实烧脑

Curry_Chen

ykcbf1100 发表于 2022-12-30 09:14
是这样吗？

对的，就是这样感谢

Curry_Chen

蓝桥玄霜 发表于 2022-12-30 09:28
最大值的例子：

感谢感谢蓝佬

supermouse24

Sub test()
'定义数组和字典
    Dim brr(2)
    Set dic = CreateObject("scripting.dictionary")
   
   
    With Worksheets("sheet1")
'名称去重并加入字典
        arr = .[a7].CurrentRegion.Value
        For irow = 2 To UBound(arr, 1)
            name_ = arr(irow, 2)
            If Not dic.exists(name_) And Not IsEmpty(name_) Then
                dic(name_) = brr
            End If
        Next
'经过从上到下对比，符合要求的替换名称中的数组。所以sheet1的时间排列应该从上到下逐渐递增。
        For irow = 2 To UBound(arr, 1) - 1
            name_ = arr(irow, 2)
            If dic.exists(name_) And dic(name_)(2) <= arr(irow, 3) Then
                crr = Array(arr(irow, 1), name_, arr(irow, 3))
                dic(name_) = crr
            End If
        Next
    End With
'打印
    With Worksheets("sheet2")
        .[a:c].Clear
        .[a1].Resize(1, 3) = Array("时间", "名称", "value")
        irow = 2
        For Each k In dic.Keys
            .Cells(irow, 1).Resize(1, 3) = dic(k)
            irow = irow + 1
        Next
    End With
   
End Sub

dambcer

参与一下，PQ处理，懒得VBA     

cui26896

1. Sub 简单连接()
   
2. Dim cnn As Object, Rst As Object, SQL$, i&, ar
   
3. Set cnn = CreateObject("ADODB.Connection")
   
4. cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes;IMEX=1';Data Source=" & ThisWorkbook.FullName
   
5. SQL = "select 名称,max(value)as val from [sheet1$a7:C] where 名称 is not null group by 名称"
   
6. SQL = "select b.时间,a.名称,a.val from (" & SQL & ")a left join [sheet1$a7:C]b on a.名称=b.名称 and a.val=b.value order by a.名称,b.时间"
   
7. Set Rst = cnn.Execute(SQL)
   
8. With Sheet2
   
9.   .Activate
   
10.   For i = 0 To Rst.Fields.Count - 1
    
11.     .Cells(1, i + 1) = Rst.Fields(i).Name
    
12.   Next
    
13. Range("A2").CopyFromRecordset Rst
    
14. End With
    
15. cnn.Close
    
16. Set cnn = Nothing
    
17. End Sub

复制代码

cui26896

要审核，发图片。