数据去重和选较大者

GUQLM

问题已经解决，感谢各位老师帮助。

各位老师，我希望得到这样的处理结果，感谢老师们关注和帮助。

A列为有编码的人名，B列为有关的百分数。需求是：人名完全相同和百分数完全相同时，保留一对数据；人名相同，但是百分数不同，保留百分数较大或最大那对数据。如图：



去重和保留较大值.rar (8.29 KB, 下载次数: 12)

2024-7-21 11:51 上传

点击文件名下载附件

cnmlgb9998

是这个效果吗？

GUQLM

cnmlgb9998 发表于 2024-7-21 12:16
是这个效果吗？

谢谢老师快速回复。我仔细看看。方便贴出原公式吗？

cnmlgb9998

GUQLM 发表于 2024-7-21 12:18
谢谢老师快速回复。我仔细看看。方便贴出原公式吗？

=REDUCE(A1:B1,UNIQUE(A2:A25),LAMBDA(x,y,VSTACK(x,TAKE(SORT(FILTER(A2:B25,A2:A25=y),2,-1,FALSE),1))))

GUQLM

cnmlgb9998 发表于 2024-7-21 12:25
=REDUCE(A1:B1,UNIQUE(A2:A25),LAMBDA(x,y,VSTACK(x,TAKE(SORT(FILTER(A2:B25,A2:A25=y),2,-1,FALSE),1)) ...

谢谢老师。我看您的图结果应该对的，但是我操作就显示：该函数无效。肯定是我操作不对，但是我不知道应该如何操作？

ykcbf1100

参与一下，字典+数组

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.7.21
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     r = Cells(Rows.Count, 1).End(3).Row
   
4.     arr = [a1].Resize(r, 2)
   
5.     ReDim brr(1 To r, 1 To 2)
   
6.     For i = 2 To UBound(arr)
   
7.         s = arr(i, 1)
   
8.         If Not d.exists(s) Then
   
9.             m = m + 1
   
10.             d(s) = m
    
11.             brr(m, 1) = arr(i, 1)
    
12.             brr(m, 2) = arr(i, 2)
    
13.         Else
    
14.             r = d(s)
    
15.             brr(r, 2) = IIf(brr(r, 2) < arr(i, 2), arr(i, 2), brr(r, 2))
    
16.         End If
    
17.     Next
    
18.     [e2:f10000] = ""
    
19.     Columns(6).NumberFormatLocal = "0.00%"
    
20.     [e2].Resize(m, 2) = brr
    
21. End Sub
    

复制代码

Qs18

Sub qs()
Dim arr, i, dic
Set dic = CreateObject("scripting.dictionary")
With Sheet1
    arr = .Range("a2:b" & .Cells(Rows.Count, 1).End(xlUp).Row)
    ReDim brr(1 To UBound(arr), 1 To 2)
    For i = 2 To UBound(arr)
        s = arr(i, 1)
        If Not dic.exists(s) Then
            m = m + 1
            dic(s) = arr(i, 2)
        Else
            If dic(s) < arr(i, 2) Then dic(s) = arr(i, 2)
        End If
    Next
.Range("e2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys)
.Range("f2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.items)
End With
Set dic = Nothing
End Sub

cnmlgb9998

GUQLM 发表于 2024-7-21 12:33
谢谢老师。我看您的图结果应该对的，但是我操作就显示：该函数无效。肯定是我操作不对，但是我不知道应该 ...

升级你的excel 到 365

Qs18

试试........