本帖最后由 香川群子 于 2014-8-8 23:54 编辑
经确认，按规则计算结果是正确的，排序也没错……但最后输出结果时发生了错误。
现在代码已经修改完成了。
附件更新、上代码：- Function rk(Rng As Range, Optional n& = 0) '对整个区域计算后得到最终名次
- '参数1: Rng=全部数据区域
- '可选参数2: 默认n=0时按多行单列数组区域输出(使用数组三键)、n>0时输出指定序号对应的名次结果
- Dim i&, j&, m&, r&, s$, t&
-
- m = Rng.Rows.Count '读取区域总行数m 即选手人数 或每一个裁判可给出的最大分值
- ReDim x(1 To m, 1 To 2) '定义m行2列的数组 用来排序
- ReDim y(1 To m, 1 To 1) '定义m行1列的数组 输出排序结果
- For i = 1 To m
- x(i, 1) = f(Application.Index(Rng.Value, i), m, 1) '第1列用自定义函数f计算排序结果值
- x(i, 2) = i '第2列写入序号
- Next
-
- '下面是香川改进冒泡算法排序
- For i = 1 To m
- s = x(i, 1): t = x(i, 2)
- For j = i + 1 To m
- If x(j, 1) < s Then s = x(j, 1): t = x(j, 2): r = j
- Next
-
- If r Then
- x(r, 1) = x(i, 1): x(i, 1) = s
- x(r, 2) = x(i, 2): x(i, 2) = t
- r = 0
- End If
- Next
- '排序完成后 重新整理得到正确的名次结果
- For i = 1 To m
- y(x(i, 2), 1) = i
- Next
- If n Then rk = y(n, 1) Else rk = y '默认n=0时按多行单列数组区域输出二维数组结果、n>0时输出指定序号的名次
- '指定n值时、计算效率低一些但使用方便 但注意Rng区域须绝对引用。
- '而按数组三键公式使用时计算效率高
- End Function
- Function f(r, m&, Optional k& = 0) '仅计算某一行的数据 按规则得到排序结果值
- '参数1: r=单行数据区域
- '参数2: m为本组总人数、或最大分值
- '可选参数3: 默认k=0时 计算工作表区域中的行 k=1时计算VBA内存一维数组
- Dim h$, i&, l&, l2&, n&, n2&, t&, s$, ss$
-
- l = Len(CStr(m)): s = String(l - 1, "0") '计算最大分值的位数
- If k = 0 Then n = r.Count Else n = UBound(r) '获取本行列数 即裁判人数n
- n2 = (n + 1) / 2: l2 = Len(CStr(m * n2)) '计算过半数n2、以及过半时的总位数
-
- ReDim a(1 To m): ReDim b(1 To m) '数组a记录本行得分次数、顺序，数组b记录分值总和的表达式
- For i = 1 To n
- t = r(i): a(t) = a(t) & Right(s & t, l): b(t) = b(t) & "+" & Right(s & t, l)
- Next
- ss = Join(a, "") '得到排序后的全部分值ss
- h = Right(String(l2 - 1, "0") & Application.Evaluate(Left(Join(b, ""), n2 * (l + 1))), l2) '计算过半时的分值总和h
- f = "s" & Mid(ss, (n2 - 1) * l + 1, l) & "_" & Mid(ss, n2 * l + 1, l) & "h" & h & "s" & Mid(ss, (n2 + 1) * l) & "f" & Right(s & r(1), l) & "_" & ss
- '输出按6种规则及顺序计算后的排序结果值:s[过半时分值档]_[过半+1分值]h[过半总和]s[过半+1以后分值顺序]f[第1裁判给分]_[排序后的全部分值]
- End Function
单项计算.rar
(15.3 KB, 下载次数: 33)
|
楼主: EXCEL江湖
沪公网安备 31011702000001号 沪ICP备11019229号-2
楼主
发表于 2014-8-8 23:10
