如何根据原始表中班级学科分总分折算分3项填充8项名次和序号以数组形式写入目标表

yjh_27

yzyyyyyyy 发表于 2015-1-7 15:21
大师，原始表中的数组arr为930行，6列，能否定义目标数组brr()，让数组brr()930行，30列。
原始表
1  ...

1 sub aa1 '总分
   sub aa2 '折算分
  的输出列按需要对应改，如

Sub aa1() '总分
R = Range("a" & Rows.Count).End(xlUp).Row
arr = Range("a2:f" & R)
brr = YjhSort(arr, "1,2", "1,4", "R,-4;1;2")    '学科分班名
Range("p2").Resize(UBound(brr), UBound(brr, 2)) = brr

2 一次写入目标表则在每步统计后用循环写入总数组对应列，即可

yzyyyyyyy

yjh_27 发表于 2015-1-7 16:36
1 sub aa1 '总分
   sub aa2 '折算分
  的输出列按需要对应改，如

感谢大师热心帮助，不知如何写入crr()，请大师再次出手
brr = YjhSort(arr, "-1", "5", "R,0-5;1;12")     '学科分级名
brr = YjhSort(arr, "-1", "5", "R,0--5;1;12")     '学科分级名
红色部分有区别吗，多了一个杠

1. Sub aa()
   
2. dim arr,brr,crr()
   
3. '学科分
   
4. R = Range("a" & Rows.Count).End(xlUp).Row
   
5. arr = Range("a2:f" & R)
   
6. redim crr(ubound(arr),30)
   
7. brr = YjhSort(arr, "1,2", "1,5", "R,-5;1;2")    '学科分班名
   
8. Range("h2").Resize(UBound(brr), UBound(brr, 2)) = brr
   
9. brr = YjhSort(arr, "1,2,2,2", "1,5,6,4", "R,0-5;1;1")    '学科分班序
   
10. Range("I2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
11. brr = YjhSort(arr, "-1", "5", "R,0--5;1;12")     '学科分级名
    
12. Range("J2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
13. brr = YjhSort(arr, "-1,-1,-1", "5,6,4", "R,0-5;1;11")     '学科分级序
    
14. Range("k2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
15. brr = YjhSort(arr, "1,2", "1,5", "R,5;1;2")    '学科分班倒名
    
16. Range("L2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
17. brr = YjhSort(arr, "1,1,1,1", "1,5,6,4", "R,0-5;1;1")    '学科分班倒序
    
18. Range("M2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
19. brr = YjhSort(arr, "1", "5", "R,0-5;1;12")     '学科分级倒名
    
20. Range("N2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
21. brr = YjhSort(arr, "1,1,1", "5,6,4", "R,0-5;1;11")     '学科分级倒序
    
22. Range("o2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
23. '总分
    
24. brr = YjhSort(arr, "1,2", "1,4", "R,-4;1;2")    '总分班名
    
25. Range("P2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
26. brr = YjhSort(arr, "1,2,2,2", "1,4,6,4", "R,0-4;1;1")    '总分班序
    
27. Range("Q2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
28. brr = YjhSort(arr, "-1", "4", "R,0--4;1;12")     '总分级名
    
29. Range("R2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
30. brr = YjhSort(arr, "-1,-1,-1", "4,6,4", "R,0-4;1;11")     '总分级序
    
31. Range("S2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
32. brr = YjhSort(arr, "1,2", "1,4", "R,4;1;2")    '总分班倒名
    
33. Range("T2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
34. brr = YjhSort(arr, "1,1,1,1", "1,4,6,4", "R,0-4;1;1")    '总分班倒序
    
35. Range("U2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
36. brr = YjhSort(arr, "1", "4", "R,0-4;1;12")     '总分级倒名
    
37. Range("V2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
38. brr = YjhSort(arr, "1,1,1", "4,6,4", "R,0-4;1;11")     '总分级倒序
    
39. Range("W2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
40. '折算分
    
41. brr = YjhSort(arr, "1,2", "1,6", "R,-6;1;2")    '折算分班名
    
42. Range("X2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
43. brr = YjhSort(arr, "1,2,2,2", "1,6,6,6", "R,0-6;1;1")    '折算分班序
    
44. Range("Y2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
45. brr = YjhSort(arr, "-1", "6", "R,0--6;1;12")     '折算分级名
    
46. Range("Z2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
47. brr = YjhSort(arr, "-1,-1,-1", "6,6,6", "R,0-6;1;11")     '折算分级序
    
48. Range("AA2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
49. brr = YjhSort(arr, "1,2", "1,6", "R,6;1;2")    '折算分班倒名
    
50. Range("AB2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
51. brr = YjhSort(arr, "1,1,1,1", "1,6,6,6", "R,0-6;1;1")    '折算分班倒序
    
52. Range("AC2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
53. brr = YjhSort(arr, "1", "6", "R,0-6;1;12")     '折算分级倒名
    
54. Range("AD2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
55. brr = YjhSort(arr, "1,1,1", "6,6,6", "R,0-6;1;11")  '折算分级倒序
    
56. Range("AE2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
57. End Sub
    

复制代码

yjh_27

可增加指定工作表：

Sub aa1() '总分
R =sheets("原始表"). Range("a" & Rows.Count).End(xlUp).Row
arr =sheets("原始表"). Range("a2:f" & R)
sheets("目标表"). Range("a2:f" & R)=arr      '只在一个过程有即可
brr = YjhSort(arr, "1,2", "1,4", "R,-4;1;2")    '学科分班名
sheets("目标表").Range("p2").Resize(UBound(brr), UBound(brr, 2)) = brr

yzyyyyyyy

yjh_27 发表于 2015-1-7 17:07
可增加指定工作表：

Sub aa1() '总分

感谢大师热心帮助。
能否
1全部写入数组包括6列原始表，和24列名次和序号，共30列
2再将数组写入目标表

yjh_27

yzyyyyyyy 发表于 2015-1-7 17:07
感谢大师热心帮助，不知如何写入crr()，请大师再次出手
brr = YjhSort(arr, "-1", "5", "R,0-5;1;12")   ...

1   0-5   与0--5 一样，按5列统计，本列不排序（以分组序为准）

2 不知如何写入crr()
crr=arr
ReDim Preserve crr(1 To UBound(crr), 1 To 30)
brr = YjhSort(arr, "1,2", "1,5", "R,-5;1;2")    '学科分班名
for i =1 to ubound(crr)
crr(i,8) = brr(i,1)      'h列
next