根据部门找到工号中最大的一个工号 求求大家

gwjkkkkk

参与一下。。。

一招秒杀

1句全搞定，为什么你们要写那么多

lizhipei78

今铭昔

Qs18

Sub qs()
Dim arr, i, dic, s, m
Set dic = CreateObject("scripting.dictionary")
With Sheet1
    arr = .Range("a1").CurrentRegion.Value
    ReDim brr(1 To UBound(arr), 1 To 4)
    For i = 2 To UBound(arr)
        s = arr(i, 2)
        If Not dic.exists(s) Then
            m = m + 1
            dic(s) = m
            brr(m, 1) = s: brr(m, 2) = Left(arr(i, 1), 1)
            brr(m, 3) = arr(i, 1)
            brr(m, 4) = brr(m, 2) & Format(Val(Mid(brr(m, 3), 2)) + 1, "0000")
        Else
            rw = dic(s)
            If brr(rw, 3) < arr(i, 1) Then
                brr(rw, 3) = arr(i, 1)
            End If
            brr(rw, 4) = brr(rw, 2) & Format(Val(Mid(brr(rw, 3), 2)) + 1, "0000")
        
       End If
    Next
.Range("g26").Resize(m, 4) = brr
End With
Set dic = Nothing
End Sub

Qs18

试试.........................

Qs18

试试...........