怎么给每个人记账费用的前几名数据填充

沉吟1

求助各位大神，帮忙看能不能解决一下我的问题，我这边想给每个人的记账费用排名前几名数据填充或者抠出来

sxbjzjf110

yes_cn

注意：如遇E列金额是#N/A，则当做0来处理，但填色时不填这条。

longwin

请测试.....

沉吟1

longwin 发表于 2024-7-17 16:34
请测试.....

不太对，最后一个人填充的不对

沉吟1

sxbjzjf110 发表于 2024-7-17 16:15

有问题的，艾双的数据被填充了两次

longwin

沉吟1 发表于 2024-7-17 16:41
不太对，最后一个人填充的不对

最后一个人户数太少造成的，加了一个判断，最少弄1行。

longwin

代码已更新。

sxbjzjf110

沉吟1 发表于 2024-7-17 16:45
有问题的，艾双的数据被填充了两次

我这测试好着呢

usedrange

1. Sub text()
   
2.     Dim arr, i%, dic, k, n%, r%, s%, sh
   
3.     Set dic = CreateObject("scripting.dictionary")
   
4.     With Sheet1
   
5.         arr = .[a1].CurrentRegion
   
6.         n = 0
   
7.         For i = 1 To UBound(arr) - 1
   
8.             If arr(i, 3) <> arr(i + 1, 3) Then n = i + 1
   
9.             dic(n & "|" & arr(i + 1, 3)) = dic(n & "|" & arr(i + 1, 3)) + 1
   
10.         Next i
    
11.         For Each k In dic.keys
    
12.             r = Split(k, "|")(0)
    
13.             s = WorksheetFunction.Round(dic(k) * 0.1, 0)
    
14.             If s < 1 Then s = 1
    
15.             Set sh = Range("a" & r).Resize(s, 5)
    
16.             sh.Interior.ColorIndex = 6
    
17.             Set sh = Nothing
    
18.         Next k
    
19.     End With
    
20.     Set dic = Nothing
    
21. End Sub

复制代码