Filtre de données

On va y arriver (j'espère)...

Pas de copie écran mais un fichier excel aidera pour ton exemple.

On est tous scotché à excel ici

P.

Ah d'accord. Le voilà (j'ai pris l'exemple du 29/06/2017) :

Bonjour à tous,

Devant tant d'explications obscures, un essai :

Option Explicit
Sub test()
Dim dico As Object, a, i As Long, txt As String
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets(1).Range("a1").CurrentRegion
        a = .Value
        dico("phoneLine") = VBA.Array(a(1, 1), a(1, 2), a(1, 3), a(1, 4), a(1, 5), a(1, 6), a(1, 7), a(1, 8))
        For i = 2 To UBound(a, 1)
            If a(i, 5) <> "miss" Then
                txt = Join$(Array(a(i, 1), a(i, 4), a(i, 6)), Chr(2))
                If Not dico.exists(txt) Then
                    dico(txt) = VBA.Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4), a(i, 5), a(i, 6), a(i, 7), a(i, 8))
                End If
            End If
        Next
    End With
    With Sheets(2).Range("a1")
        .CurrentRegion.Clear
        .Resize(dico.Count, 8).Value = _
        Application.Transpose(Application.Transpose(dico.items))
    End With
End Sub

En fait, on ne retient qu'une seule ligne correspondant aux différentes occurences phoneLine/callingNumber/date soit la 1ère ligne rencontrée

klin89

Bonjour, et merci de ton aide Klin89.

Ton programme me retourne une erreur à la ligne 19 :

Erreur d'exécution '9':

L'indice n'appartient pas à la sélection.

Là, je crois que le problème me dépasse.

Je passe la main.

Désolé .

Bye !

Re escsr,

Il faut créer une feuille de restitution que tu placeras en 2ème position dans ton classeur

La 1ère feuille de ton classeur étant la feuille source où figurent les données à traiter

Vois ceci, ça peut-être long

En espérant avoir compris 8)

Option Explicit
Sub test()
Dim a, w(), i As Long, j As Long, n As Long, txt As String, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets(1).Range("a1").CurrentRegion
        a = .Value
        For i = 2 To UBound(a, 1)
            If i < UBound(a, 1) - 1 Then
                If a(i + 1, 3) = 0 And a(i + 1, 4) <> a(i, 4) Then a(i + 1, 3) = "M"  'comme manqués
            End If
            If a(i, 5) <> "miss" Then
                If a(i, 3) <> 0 Then
                    txt = Join$(Array(a(i, 1), a(i, 4)), Chr(2))
                    If Not dico.exists(txt) Then
                        ReDim w(1 To 8, 1 To 1)
                    Else
                        w = dico(txt)
                        ReDim Preserve w(1 To 8, 1 To UBound(w, 2) + 1)
                    End If
                    For j = 1 To UBound(w, 1)
                        w(j, UBound(w, 2)) = a(i, j)
                    Next
                    dico(txt) = w
                End If
            End If
        Next
    End With
    Application.ScreenUpdating = False
    'restitution et mise en forme
    With Sheets(2).Range("a1")
        .CurrentRegion.Cells.Clear
        .Parent.Columns(2).NumberFormat = "@"
        .Resize(1, 8).Value = Array("phoneLine", "datetime", "duration", _
                                    "callingNumber", "nature", "date", "time", "idkey")
        n = 1
        For i = 0 To dico.Count - 1
            With .Offset(n).Resize(UBound(dico.items()(i), 2), UBound(dico.items()(i), 1))
                .FormulaLocal = Application.Transpose(dico.items()(i))
                .BorderAround Weight:=xlThin
            End With
            n = n + UBound(dico.items()(i), 2)
        Next
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .HorizontalAlignment = xlCenter
                .BorderAround Weight:=xlThin
                .Interior.ColorIndex = 40
            End With
            .Columns.ColumnWidth = 16
        End With
    End With
    Application.ScreenUpdating = True
    Set dico = Nothing
End Sub

klin89

Re escsr,

Remarque :

Dans le listing d'appels reçus, l'appel en ligne 41 vient s'intercaler dans la partie jaune, comme ci la séquence chronologique des appels reçus (colonne G) n'était pas respecté !

Edit : je suis absent toute la journée.

klin89

gmb a écrit :

Là, je crois que le problème me dépasse.

Je passe la main.

Désolé .

Bye !

Pas de soucis, merci de ton aide, bye !

@Klin89

C'est ça !! Ton premier programme marche, il fallait en effet juste créer une nouvelle feuille. Ça filtre correctement les appels. Il y a juste ce problème de date déjà rencontré avec le programme de gmb et patrick1957. Des 12/06/2017 (12 juin 2017) se transforme en 06/12/2017 (6 décembre 2017). Une idée de solution ?

Et qu'est-ce que fait le deuxième programme que tu as posté juste au dessus ?

Mon problème est réglé, je met donc ce topic en résolu.

Merci à ceux qui m'ont aidé. Bonne continuation à tous !