VBA实现区间隔行中式排名?

On_fire

VBA实现区间,隔列中式排名?

祝各位老师, 大神, 新年快乐! 万事如意! 大吉大利!

1. 数据格式是每9行是一组

2. A列是区域的判断条件

代码需求:

在A列区间, 对K列的每一组內, 每一行对应的数据做中式升序排名及标示在L列

(部分模拟结果: 格内同一颜色的值进行排名)

因为数据N多, 请老师, 大神帮帮忙...谢谢…

liulang0808

楼主的需求没有看明白
http://club.excelhome.net/thread-1385473-1-1.html 有中国式排名的帖子，可以参考

On_fire

liulang0808 发表于 2018-2-18 09:46
楼主的需求没有看明白
http://club.excelhome.net/thread-1385473-1-1.html 有中国式排名的帖子，可以参考

谢谢老师…新年快乐!

数据结构:每9行多列1组(1~9, 10~18, 19~27…)
每1组数据有9行(由1到9行)
比如:

1~9行, K列的K1=10是第1组数据的第1行(标藍),

10~17行, K列的K10=10是第2组数据的第1行(标藍),

28~36行, K列的K28=25是另一组数据的第1行(标藍)

因为这3组数据的A列是一样的(=同一区间内),
所以要用这3组数据的第1行进行中式排名, 标示在L列(新添加)
(19~27行因为A列是的值是2, 不需要参与排名),
如此类推...
同一区间内, 各自的第2行, 第3行...直到第9行进行排名..

计算逻辑有点繁琐, 昨天找了一天, 也找不到可以参考的帖...

duquancai

liulang0808 发表于 2018-2-18 09:46
楼主的需求没有看明白
http://club.excelhome.net/thread-1385473-1-1.html 有中国式排名的帖子，可以参考

手机上网中，也看不懂楼主的“需求”！

On_fire

duquancai 发表于 2018-2-18 10:46
手机上网中，也看不懂楼主的“需求”！

谢谢老师…新年快乐!

数据结构:每9行多列1组(比如:1~9, 10~18, 19~27…)

每1组数据有9行(由1到9行)
比如:

1~9行, K列的K1=10是第1组数据的第1行(标藍),

10~17行, K列的K10=10是第2组数据的第1行(标藍),

28~36行, K列的K28=25是另一组数据的第1行(标藍)

因这3组数据的A列是一样( = 同一区间内),
所以用这3组数据的第1行进行中式排名, 标示在L列(新添加)
(注: 19~27行, 因为A列的值是2, 故不需要参与排名)

如此类推...
在同一区间内, 各组的第2行, 第3行...直到第9行进行排名..


计算逻辑有点繁琐, 昨天找了一天, 也找不到可以参考的帖...


可能要用字典嵌套...己看了一些帖子, 可惜都看不懂..

today0427

昨天把附件下载了都没看懂 所以放弃了

On_fire

baigangliao 发表于 2018-2-18 15:03
感觉很复杂,但是楼主没有描述清楚,不清楚要达到的效果.

谢谢老师, 新年好…

每1组数据有9行(由1到9行)
比如:
1~9行, K列的单元格K1=10是第1组数据的第1行(标蓝),
10~17行, K列的单元格K10=10是第2组数据的第1行(标蓝),
28~36行, K列的单元格K28=25是另一组数据的第1行(标蓝)
K列每组的第1行, = 10, 10, 25,
= 1, 1, 2 (L列=中式排名)
…
1~9行, K列的单元格K5=5是第1组数据的第5行(标橙色),
10~17行, K列的单元格K14=6是第2组数据的第5行(标橙色),
28~36行, K列的单元格K32=33是另一组数据的第5行(标橙色)
K列每组的第5行,
=5, 6, 33,
= 1, 2, 3 (L列=中式排名)

…
1~9行, K列的单元格K9=9是第1组数据的第9行(标綠色),
10~17行, K列的单元格K18=10是第2组数据的第9行(标綠色),
28~36行, K列的单元格K36=3是另一组数据的第9行(标綠色)
K列每组的第9行,
=9, 10, 3,
= 2, 3, 1 (L列=中式排名)



因这3组数据的A列是一样( = 同一区间内),
所以用这3组数据的各行, 进行中式排名, 标示在L列(新添加)
(注: 19~27行, 因为A列的值是2, 故不需要参与排名)

On_fire

today0427 发表于 2018-2-18 15:15
昨天把附件下载了都没看懂 所以放弃了

谢谢老师, 新年好…

一把小刀闯天下

'怎么理解怎么写，估计差不多的
　
Option Explicit
　
Sub test()
　Dim arr, i, cnt, j, n, brr, t, m, k, crr
　arr = Range("a1:k" & Cells(Rows.Count, "a").End(xlUp).Row)
　If UBound(arr, 1) Mod 9 > 0 Then MsgBox "!": Exit Sub
　cnt = UBound(arr, 1) \ 9
　ReDim brr(1 To cnt, 1 To 3), crr(1 To UBound(arr, 1), 1 To 1)
　For i = 1 To cnt: brr(i, 3) = i: Next
　For i = 1 To 9
　　n = 0
　　For j = 1 To cnt
　　　If arr((j - 1) * 9 + i, 1) = 1 Then
　　　　n = n + 1: brr(n, 1) = arr((j - 1) * 9 + i, 11)
　　　End If
　　Next
　　For j = 1 To n - 1
　　　For k = j + 1 To n
　　　　If brr(j, 1) > brr(k, 1) Then
　　　　　t = brr(j, 1): brr(j, 1) = brr(k, 1): brr(k, 1) = t
　　　　　t = brr(j, 3): brr(j, 3) = brr(k, 3): brr(k, 3) = t
　　　　End If
　　Next k, j
　　m = 1: brr(1, 2) = m
　　For j = 2 To n
　　　If brr(j, 1) <> brr(j - 1, 1) Then m = m + 1
　　　brr(j, 2) = m
　　Next
　　For j = 1 To n - 1
　　　For k = j + 1 To n
　　　　If brr(j, 3) > brr(k, 3) Then
　　　　　t = brr(j, 3): brr(j, 3) = brr(k, 3): brr(k, 3) = t
　　　　　t = brr(j, 2): brr(j, 2) = brr(k, 2): brr(k, 2) = t
　　　　End If
　　Next k, j
　　n = 0
　　For j = 1 To cnt
　　　If arr((j - 1) * 9 + i, 1) = 1 Then
　　　　n = n + 1
　　　　crr((j - 1) * 9 + i, 1) = brr(n, 2)
　　　End If
　Next j, i
　[m1].Resize(UBound(crr, 1), 1) = crr  '输出m列，做个比较
End Sub