[已解决]求统计个数与合计

cyj153

CheryBTL 发表于 2013-11-11 00:22
D列数据固定不动，直接引用了这里的数据：

谢谢老师，是要达到这样的效果，只是班级还是最好引用源数据（因为班级是动态的）。另外，下面的名次统计也您以前帮写的，现在想将其两段代码合为一个。还请您麻烦指导！万分感谢！

Sub 名次统计()
   Dim ar, re, per, temp
   Dim i As Integer, j As Integer, Rnum As Integer
   per = Array(10, 9, 7, 6, 5, 4, 3, 2, 1) '定义一个常量数组，第一名10分，第二名9分，依次类推
   Rnum = Sheet5.[bp65536].End(3).Row '确认D列最后一行数据的行数
   ar = Sheet5.Range("bq7:by" & Rnum) '提取E列到M列所有数组并赋值给数组ar
   
    ReDim re(1 To UBound(ar), 1 To 2) '重定义结果数组，与源数据纬度一样，一列是总分，一分是排名
    ReDim temp(1 To UBound(ar))  '定时临时数组，用来存放处理后的总成绩（总分+各项成绩处理的成绩）
    For i = 1 To UBound(ar)
        For j = 1 To UBound(ar, 2)
            re(i, 1) = re(i, 1) + ar(i, j) * per(j - 1)
            temp(i) = temp(i) + ar(i, j) / 10 ^ (j * 2)
        Next j
        temp(i) = temp(i) + re(i, 1)
    Next i '得到结果数组第一列的总分和处理过后的临时数组
    For i = 1 To UBound(re)
        For j = 1 To UBound(re)
            If temp(i) < temp(j) Then re(i, 2) = re(i, 2) + 1
            '通过临时数组排序
        Next j
        re(i, 2) = re(i, 2) + 1
    Next i
    Sheet5.[bz7].Resize(UBound(re), 2) = re '输出总分和排名
End Sub

CheryBTL

cyj153 发表于 2013-11-11 08:10
谢谢老师，是要达到这样的效果，只是班级还是最好引用源数据（因为班级是动态的）。另外，下面的名次统计 ...

你这个排序对文本+数字根本不管用，你直接用Excel自带的排序看看？而且班级的名称可以只有数字就很好办了。

cyj153

CheryBTL 发表于 2013-11-11 08:27
你这个排序对文本+数字根本不管用，你直接用Excel自带的排序看看？而且班级的名称可以只有数字就很好办了 ...

好的，您就不用考虑排序了，直接引用源数据班级，我准备改用数值为班级名称。谢谢您的指导！

CheryBTL

cyj153 发表于 2013-11-11 09:26
好的，您就不用考虑排序了，直接引用源数据班级，我准备改用数值为班级名称。谢谢您的指导！

已改三纯数字 就方便多了，见附件：
另外，对于不同年级也可以通过数字来先代替，后来再还原即可。
统计名次.rar (44.49 KB, 下载次数: 4)

2013-11-11 09:35 上传

点击文件名下载附件

CheryBTL

也可以中间带数字的方法，但对名称的一致性要求较高，请测试：
统计名次按初中(数字)排序.rar (44.77 KB, 下载次数: 3)

2013-11-11 09:40 上传

点击文件名下载附件

cyj153

CheryBTL 发表于 2013-11-11 09:36
已改三纯数字 就方便多了，见附件：
另外，对于不同年级也可以通过数字来先代替，后来再还原即可。

谢谢，能否将这段代码合并起来。用10楼附件
Sub 名次统计()
   Dim ar, re, per, temp
   Dim i As Integer, j As Integer, Rnum As Integer
   per = Array(10, 9, 7, 6, 5, 4, 3, 2, 1) '定义一个常量数组，第一名10分，第二名9分，依次类推
   Rnum = Sheet5.[bp65536].End(3).Row '确认D列最后一行数据的行数
   ar = Sheet5.Range("bq7:by" & Rnum) '提取E列到M列所有数组并赋值给数组ar
   
    ReDim re(1 To UBound(ar), 1 To 2) '重定义结果数组，与源数据纬度一样，一列是总分，一分是排名
    ReDim temp(1 To UBound(ar))  '定时临时数组，用来存放处理后的总成绩（总分+各项成绩处理的成绩）
    For i = 1 To UBound(ar)
        For j = 1 To UBound(ar, 2)
            re(i, 1) = re(i, 1) + ar(i, j) * per(j - 1)
            temp(i) = temp(i) + ar(i, j) / 10 ^ (j * 2)
        Next j
        temp(i) = temp(i) + re(i, 1)
    Next i '得到结果数组第一列的总分和处理过后的临时数组
    For i = 1 To UBound(re)
        For j = 1 To UBound(re)
            If temp(i) < temp(j) Then re(i, 2) = re(i, 2) + 1
            '通过临时数组排序
        Next j
        re(i, 2) = re(i, 2) + 1
    Next i
    Sheet5.[bz7].Resize(UBound(re), 2) = re '输出总分和排名
End Sub

CheryBTL

cyj153 发表于 2013-11-11 10:42
谢谢，能否将这段代码合并起来。用10楼附件
Sub 名次统计()
   Dim ar, re, per, temp

你15楼的附件你看了么？

cyj153

CheryBTL 发表于 2013-11-11 10:46
你15楼的附件你看了么？

我要用14楼的附件（不是10楼，刚才写错了，也不用15楼）。谢谢！

cyj153

cyj153 发表于 2013-11-11 11:18
我要用14楼的附件（不是10楼，刚才写错了，也不用15楼）。谢谢！

统计.rar (39.26 KB, 下载次数: 3)

2013-11-11 13:09 上传

点击文件名下载附件
可能是表达不清楚，特弄个附件，要求将里面的两段代码合并，去掉重复代码。在达成最后的表中效果。谢谢指导！

yyyydddd8888

cyj153 发表于 2013-11-11 13:11
可能是表达不清楚，特弄个附件，要求将里面的两段代码合并，去掉重复代码。在达成最后的表中效果。谢谢 ...

请测试：

统计.zip (64.6 KB, 下载次数: 6)

2013-11-11 14:14 上传

点击文件名下载附件