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

5w5ww

根据部门找到工号中最大的一个工号
（其中会出现两个部门共用一个字母代号）公式，vba都可

liujing_hotwind

=H4&TEXT(MAX(IFERROR((B:B=G4)*RIGHT(A:A,4),0)),"0000") 数组三键

tel3033

供参考……

everbest2015

Sub Main()
    Dim sh As Worksheet
    Dim d As Object
    Dim arr, brr
    Dim i As Integer
    Dim hao As Variant
    Dim ma As String
    Dim k As String
    Dim s As String
    Set d = CreateObject("scripting.dictionary")
    Set sh = Sheet1
    With sh
        .AutoFilterMode = False
        arr = .Range("a1").CurrentRegion.Value
        For i = 2 To UBound(arr)
            ma = Left(arr(i, 1), 1)
            k = arr(i, 2) & "," & ma
            hao = Mid(arr(i, 1), 2)
            If Not d.exists(k) Then
                d(k) = Array(ma, hao)
            Else
                brr = d(k)
                If hao > d(k)(1) Then brr(1) = hao: d(k) = brr
            End If
        Next
    End With
    If d.Count = 0 Then Exit Sub
    sh.Range("I:K").ClearContents
    Erase arr
    arr = sh.Range("g4").CurrentRegion.Resize(, 3)
    For i = 1 To UBound(arr)
        s = arr(i, 1) & "," & arr(i, 2)
        If d.exists(s) Then arr(i, 3) = arr(i, 2) & d(s)(1)
    Next
     sh.Range("g4").CurrentRegion.Resize(, 3) = arr
End Sub

ykcbf1100

结果已+1

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.8.9
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("Sheet1")
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         arr = .[a1].Resize(r, 2)
   
6.         For i = 2 To UBound(arr)
   
7.             s = arr(i, 2)
   
8.             st1 = Left(arr(i, 1), 1)
   
9.             st2 = Val(Mid(arr(i, 1), 2))
   
10.             If Not d.exists(s) Then
    
11.                 d(s) = Array(st1, st2)
    
12.             Else
    
13.                 t = d(s)
    
14.                 t(1) = IIf(t(1) < st2, st2, t(1))
    
15.                 d(s) = t
    
16.             End If
    
17.         Next
    
18.         ReDim brr(1 To d.Count, 1 To 3)
    
19.         For Each k In d.keys
    
20.             m = m + 1
    
21.             brr(m, 1) = k
    
22.             brr(m, 2) = d(k)(0)
    
23.             brr(m, 3) = d(k)(0) & Format(d(k)(1) + 1, "0000")
    
24.         Next
    
25.         .[g4].Resize(1000, 3) = ""
    
26.         .[g4].Resize(m, 3) = brr
    
27.     End With
    
28. End Sub
    

复制代码

limonet

公式嵌套：=XLOOKUP(G4,B:B,A:A,,,-1)

limonet

加一：=LEFT(XLOOKUP(G4,B:B,A:A,,,-1))&TEXT(RIGHT(XLOOKUP(G4,B:B,A:A,,,-1),4)+1,"0000")

lizhipei78

最简单的办法就是先自定义两列降序排序，然后vlookup取值就可以了，这个速度最快

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, br, cr, i&, j&, r&, dic As Object, vKey
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    ar = [A1].CurrentRegion.Value
    For i = 2 To UBound(ar)
        vKey = ar(i, 2) & "|" & Left(ar(i, 1), 1)
        dic(vKey) = dic(vKey) & " " & Mid(ar(i, 1), 2)
    Next i
   
    ReDim ar(1 To dic.Count, 2)
    For Each vKey In dic.keys
        br = Split(dic(vKey))
        bSort1 br, 1, UBound(br), False
        r = r + 1
        cr = Split(vKey, "|")
        ar(r, 0) = cr(0)
        ar(r, 1) = cr(1)
        br(1) = Format(br(1) + 1, "0000")
        ar(r, 2) = cr(1) & br(1)
    Next
    [G4].Resize(UBound(ar), 3) = ar
   
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub
Function bSort1(ByRef ar, ByVal iFirst&, ByVal iLast&, _
    Optional ByVal isOrder As Boolean = True)
    Dim i&, j&, vTemp
   
    For i = iFirst To iLast - 1
        For j = iFirst To iLast + iFirst - 1 - i
            If ar(j) <> ar(j + 1) Then
                If ar(j) < ar(j + 1) Xor isOrder Then
                    vTemp = ar(j)
                    ar(j) = ar(j + 1)
                    ar(j + 1) = vTemp
                End If
            End If
        Next j
    Next i
End Function