求助一个自动生成学生考级证书编号的代码！通过函数好像没法实现，谢！

zjjEH

为了农村孩子的全面发展，请各位大侠赐教！

donghui2363

编号的组成：年份后2位+月份2位数+日期2位数+第1次过级全校的排名
191162003这里的62是日期吗？

zjjEH

donghui2363 发表于 2019-11-27 09:11
编号的组成：年份后2位+月份2位数+日期2位数+第1次过级全校的排名
191162003这里的62是日期吗？

是六年级2班

zjjEH

zjjEH 发表于 2019-11-28 08:11
是六年级2班

日期后两位不要。对不住，一点小错

zjjEH

编号的组成：年份后2位+月份2位数+年级班次+第1次过级全校的排名

一把小刀闯天下

'消息收到，看不太懂

'第2次通过的没有看到>=90的分数，按第1次通过生成的编号
'如果真有第n次通过的可把第n-1到第1次通过的人的分数置-1,编号从第n-1最大编号+1开始

'没注意还要带班级输出的，稍作修改，，，

Option Explicit

Sub test()
  Dim arr, y, m, mark, i, j
  mark = Split("?,一,二,三,四,五,六,七,八,九", ",")
  arr = Range("a3:f" & Cells(Rows.Count, "b").End(xlUp).Row)
  y = right(Year(Date), 2): m = Format(Month(Date), "00")
  For i = 1 To UBound(arr, 1)
    arr(i, 1) = vbNullString: arr(i, 3) = -i
    If arr(i, 6) < 90 Then arr(i, 6) = -1
    arr(i, 2) = Replace(arr(i, 2), "(", vbNullString)
    arr(i, 2) = Replace(arr(i, 2), ")", vbNullString)
    For j = 0 To UBound(mark)
      arr(i, 2) = Replace(arr(i, 2), mark(j), j)
    Next
  Next
  Call bsort(arr, 1, UBound(arr, 1), 1, UBound(arr, 2), 6)
  For i = 1 To UBound(arr, 1)
    If arr(i, 6) = -1 Then Exit For
    arr(i, 1) = y & m & arr(i, 2) & Format(i, "000")
  Next
  Call bsort(arr, 1, UBound(arr, 1), 1, UBound(arr, 2), 3)
  [j3].Resize(UBound(arr, 1)) = arr
End Sub

Function bsort(arr, first, last, left, right, key)
  Dim i, j, k, t
  For i = first To last - 1
    For j = first To last + first - 1 - i
      If arr(j, key) < arr(j + 1, key) Then
        For k = left To right
          t = arr(j, k): arr(j, k) = arr(j + 1, k): arr(j + 1, k) = t
        Next
      End If
    Next
  Next
End Function

dalyfreak

思路：1、根据"得分"列和“证书编号”列，筛选出需要编号的行2、获取系统年份月份日期格式化数据，再根据其排名编排出编号

这个实现不难

zjjEH

一把小刀闯天下 发表于 2019-11-28 19:37
'消息收到，看不太懂

'第2次通过的没有看到>=90的分数，按第1次通过生成的编号

对于第一次生成很成功，但第二次考试后再生成证号不能变以前的证号，只对以前未取证且上90分的学生进行编号。

月关

我是 "为了农村孩子的全面发展" 才打开附件看看，找了半天愣没找到。。。。难不成是我与互联网隔绝的这俩周又出的什么新梗？
编号的组成：年份后2位+月份2位数+日期2位数+第1次过级全校的排名，——假如是第2次编号，要不要把第1批次过级的人头算进去？

horselyq

给每次考试加个每次考试日期就可以了，不要用系统日期。