VBA方法实现最大值留取

42921783

想要实现的效果如C列函数结果，如果用VBA，怎么弄。

liulang0808

楼主这个使用字典实现吧

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Set d = CreateObject("scripting.dictionary")
    arr = [a1].CurrentRegion
    For j = 2 To UBound(arr)
        If d.exists(arr(j, 1)) Then
            If arr(j, 2) > arr(d(arr(j, 1)), 2) Then
                d(arr(j, 1)) = j
            End If
        Else
            d(arr(j, 1)) = j
        End If
    Next j
    For j = 0 To d.Count - 1
        arr(d.items()(j), 3) = arr(d.items()(j), 2)
    Next j
    [a1].CurrentRegion = arr
    Application.ScreenUpdating = True
End Sub

liulang0808

附件内容供参考

Edifier_1989

Sub M()
    arr = [a2].CurrentRegion
    Set dic = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        If dic.exists(arr(i, 1)) Then
            If dic(arr(i, 1)) < arr(i, 2) Then
                dic(arr(i, 1)) = arr(i, 2)
            End If
        Else
            dic(arr(i, 1)) = arr(i, 2)
        End If
    Next
    [d3].Resize(dic.Count, 2) = Application.Transpose(Array(dic.keys, dic.items))
End Sub

yeminqiang

1. Sub cdsr()
   
2.     Dim arr
   
3.     arr = Range("a2:c" & Cells(Rows.Count, 1).End(xlUp).Row)
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set d1 = CreateObject("scripting.dictionary")
   
6.     For i = 1 To UBound(arr)
   
7.         If Not d.exists(arr(i, 1)) Then
   
8.             d(arr(i, 1)) = arr(i, 2)
   
9.             d1(arr(i, 1)) = i
   
10.             arr(i, 3) = arr(i, 2)
    
11.         Else
    
12.             If arr(i, 2) > d(arr(i, 1)) Then
    
13.                 d(arr(i, 1)) = arr(i, 2)
    
14.                 arr(i, 3) = arr(i, 2)
    
15.                 arr(d1(arr(i, 1)), 3) = ""
    
16.                 d1(arr(i, 1)) = i
    
17.             End If
    
18.         End If
    
19.     Next
    
20.     [a2].Resize(UBound(arr), 3) = arr
    
21. End Sub
    

复制代码