vba 横向排名问题

山城子

横向排名问题2.rar (517.25 KB, 下载次数: 3)

2024-9-8 22:14 上传

点击文件名下载附件

，库存量排名前的进行横向排名，并写入到对应的的位置中， 根据X:AG列是数据源进行横向计算排名，把排名前3的结果写到N:W列，麻烦老师帮忙指导一下，谢谢

山城子

自己顶一下

chxw68

山城子 发表于 2024-9-8 12:42
自己顶一下

神仙也难看懂！哪些是原始数据？哪些是计算结果？每个数据计算规则是什么？

山城子

不好意思，前面没有表达清楚，附件改了一下，再帮忙看一看。根据X:AG列是数据源进行横向计算排名，把排名前3的结果写到N:W列，

Qs18

1. Sub qs()
   
2. Dim arr, brr, i
   
3. With Sheet1
   
4. r = .Cells(Rows.Count, 1).End(3).Row
   
5. arr = .Range("x5").Resize(r, 10)
   
6. brr = .Range("x5").Resize(r, 10)
   
7. ReDim crr(1 To r, 1 To 10)
   
8. For j = 1 To UBound(arr)
   
9.     For i = 1 To UBound(arr, 2)
   
10.         k = UBound(arr, 2) - 1
    
11.         For x = 1 To k
    
12.             If arr(j, x) < arr(j, x + 1) Then
    
13.                 t = arr(j, x)
    
14.                 arr(j, x) = arr(j, x + 1)
    
15.                 arr(j, x + 1) = t
    
16.                 k = k - 1
    
17.             End If
    
18.         Next
    
19.     Next
    
20. Next j
    
21. For j = 1 To UBound(arr)
    
22.     For i = 1 To 3
    
23.         For x = 1 To UBound(brr, 2)
    
24.             If arr(j, i) <> Empty Then
    
25.                 If arr(j, i) = brr(j, x) Then
    
26.                     crr(j, x) = i
    
27.                     Exit For
    
28.                 End If
    
29.             End If
    
30.         Next
    
31.     Next
    
32. Next j
    
33. .Range("n5").Resize(r, 10) = crr
    
34. End With
    
35. End Sub
    

复制代码

Qs18

试试.......

Qs18

试试......

山城子

Qs18 发表于 2024-9-9 06:59
试试......

非常感谢老师，还有一点点小问题（出现两个库存一样的情况只显两个排名），麻烦帮忙改一下 ，如果出现库存相同的，也按1到3的排名数字（如库存 是5，5，5，则排名1，2，3或3，2，1）

chxw68

这次说明非常清楚！

Qs18

山城子 发表于 2024-9-9 08:12
非常感谢老师，还有一点点小问题（出现两个库存一样的情况只显两个排名），麻烦帮忙改一下 ，如果出现库 ...

好，我看看。。。。。