Ne pas compter les doublons

[alcalzone]

Bonjour à toutes et tous. Voici mon problème du jour. Je dois compter sur une liste de 20 000 lignes le nombre de N° de série différents, le nombre de N° de série différents vu par chaque technicien.
Compte tenu du nombre de ligne de ma feuille et le nombre de technicien (50), la rapidité de calcul est importante.
Merci de votre aide

 

[pierrejean]

Bonjour alcalzone

Un essai

 

[klin89]

Bonsoir alcalzone, pierrejean

A tester :

Option Explicit
Sub test()
Dim a, b(), w(), e, i As Long, n As Long
    With Sheets("feuil1").Range("a2").CurrentRegion
        a = .Value
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                If Not .exists(a(i, 2)) Then
                    ReDim w(1 To 2)
                    w(1) = 0
                    Set w(2) = CreateObject("Scripting.Dictionary")
                    'w(2).CompareMode = 1
                Else
                    w = .Item(a(i, 2))
                End If
                If Not w(2).exists(a(i, 1)) Then
                    w(2)(a(i, 1)) = Empty
                    w(1) = w(1) + 1
                End If
                .Item(a(i, 2)) = w
            Next
            ReDim b(1 To .Count + 1, 1 To 2)
            n = 1
            b(n, 1) = "Technicien"
            b(n, 2) = "N° de série"
            For Each e In .keys
                n = n + 1
                b(n, 1) = e
                b(n, 2) = .Item(e)(1)
            Next
        End With
    End With
    'Restitution
    Application.ScreenUpdating = False
    With Sheets("Feuil2").Range("a1")
        .CurrentRegion.Cells.Clear
        With .Resize(UBound(b, 1), UBound(b, 2))
            .Value = b
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .Font.Size = 11
                .Interior.ColorIndex = 44
                .BorderAround Weight:=xlThin
                .HorizontalAlignment = xlCenter
            End With
            .Columns(1).HorizontalAlignment = xlCenter
        End With
        .Parent.Activate
    End With
    Application.ScreenUpdating = True
End Sub

klin89

 

[laetitia90]

bonjour Alcalzone ,Klin , Pierre jean
on pourrait simplifier dans le cas present??
je traite sur place on pourrait restituer ailleurs

Sub es()
Dim t(), m As Object, i As Long
Application.ScreenUpdating = 0
Range("a3:b" & Cells(Rows.Count, 1).End(3).Row).RemoveDuplicates _
Columns:=Array(1, 2)
t = Range("b3:b" & Cells(Rows.Count, 1).End(3).Row)
Set m = CreateObject("Scripting.Dictionary")
m.CompareMode = vbTextCompare
For i = 1 To UBound(t): m(t(i, 1)) = m(t(i, 1)) + 1: Next i
Range("a3:b" & Cells(Rows.Count, 1).End(3).Row).ClearContents
[b3].Resize(m.Count, 1) = Application.Transpose(m.keys)
[a3].Resize(m.Count, 1) = Application.Transpose(m.items)
End Sub

 

[pierrejean]

Bonjour a tous et bises à laetitia

Ben moi je complique !!
Version avec total d'interventions par technicien

 

[gosselien]

Bonjour,

sans VBA mais un TCD ...

P.

 

[alcalzone]

Bonjour à tous,
J'ai inséré la solution de Pierrejean qui fonctionne très bien mais la solution de Klin89 m'ouvre d'autres possibilités.
Je vais faire de nouveaux essais.
En tous cas, merci à tous d'avoir pris du temps pour me trouver les solutions