+ Répondre à la discussion
Page 1 sur 2 12 DernièreDernière
Affichage des résultats 1 à 20 sur 32
  1. #1
    Invité de passage
    Homme Profil pro
    Inscrit en
    juillet 2012
    Messages
    65
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations forums :
    Inscription : juillet 2012
    Messages : 65
    Points : 4
    Points
    4

    Par défaut Transformer et adapter INDEX/EQUIV en boucle vba

    Bonjour,

    sur ma feuille 1, j'ai ma colonne D avec des infos et une colonne E avec des équipements (non classés et avec redondance...)

    sur ma feuille 5, j'ai une colonne F qui reprend les équipements de la feuille 1, colonne E et les classes par nombre et ayant auparavant effacer les doublons.

    sur ma feuille 5, en colonne I, j'ai mis en place cette formule :

    Code :
    =INDEX('Feuille_1'!D:D; EQUIV(F2;'Feuille_1'E:E!;0))
    ça fonctionne et ça me retourne bien l'info de la première infos trouvée en feuille 1 et correspondant à la cellule F de la feuille 5 (mais pas les suivantes...)

    Je voudrais boucler cette formule en vba pour qu'elle me liste les une au dessous des autres les infos, qu'elle passe une ligne une fois que le mot recherché n'a plus de nouvelles infos et qu'elle continue ainsi de suite jusqu'à la fin de la colonne F...

    J'espère que c'est clair car même moi, je trouve ça un peu compliqué à écrire ^^

    D'avance merci

    Akhlan

  2. #2
    Expert Confirmé Sénior
    Homme Profil pro
    aucune
    Inscrit en
    septembre 2011
    Messages
    6 795
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : septembre 2011
    Messages : 6 795
    Points : 12 900
    Points
    12 900

    Par défaut

    Bonjour,

    Je ne comprends pas ce bout de phrase :

    et les classes par nombre
    sinon, oui, c'est possible.
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  3. #3
    Invité de passage
    Homme Profil pro
    Inscrit en
    juillet 2012
    Messages
    65
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations forums :
    Inscription : juillet 2012
    Messages : 65
    Points : 4
    Points
    4

    Par défaut

    Merci Daniel.C,

    sur la feuille 2, en colonne G, j'ai cette fonction

    Code :
    =NB.SI('Feuille_1'!E:E;F2)
    ce qui me permet de classer la colonne F par nombre d’occurrence en jouant entre ces deux colonnes F et G

  4. #4
    Expert Confirmé
    Homme Profil pro
    Retraité
    Inscrit en
    avril 2011
    Messages
    1 733
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Retraité

    Informations forums :
    Inscription : avril 2011
    Messages : 1 733
    Points : 3 825
    Points
    3 825

    Par défaut

    Bonjour,

    Tu peux commencer avec ce code qui te permettra de trouver les informations associées aux équipements listés en feuille 5 (notée Feuille_5 dans le code, à adapter si nécessaire).
    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    Sub Rechercher()
    Dim Plage As Range, Cel As Range, C As Range
    Dim LigneAjout As Long
    Dim firstAddress As String
        Application.ScreenUpdating = False
        With Worksheets("Feuille_5")
            Set Plage = .Range("F2:F" & .Range("F" & Rows.Count).End(xlUp).Row)
            For Each Cel In Plage
                Set C = Worksheets("Feuille_1").Columns(5).Find(Cel, LookIn:=xlValues, lookat:=xlPart)
                If Not C Is Nothing Then
                    firstAddress = C.Address
                    Do
                        LigneAjout = .Range("I" & Rows.Count).End(xlUp).Row + 1
                        .Range("I" & LigneAjout).Value = C.Offset(0, -1)
                        Set C = Worksheets("Feuille_1").Columns(5).FindNext(C)
                    Loop While Not C Is Nothing And C.Address <> firstAddress
                End If
            Next Cel
        End With
        Application.ScreenUpdating = True
        Set Plage = Nothing: Set Cel = Nothing: Set C = Nothing
    End Sub
    Cordialement.

  5. #5
    Invité de passage
    Homme Profil pro
    Inscrit en
    juillet 2012
    Messages
    65
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations forums :
    Inscription : juillet 2012
    Messages : 65
    Points : 4
    Points
    4

    Par défaut

    Félicitation gFZT82, c'est un très bon premier jet

    J'ai cependant une erreur à la fin du déroulement de la macro

    Erreur d'exécution '13':
    Incompatibilité de type
    ma colonne (Feuille 1 / D) et ma colonne (Feuille 5 /J) sont de type Texte

    Pour info, certaines cellules de la colonne (Feuille 1 / D) commencent par ====

    Comme tu l'as peut-être remarqué, j'ai changé la colonne (Feuille 5 /I) par (Feuille 5 /J) car je voudrais que qu'en I, la valeur C de ta macro apparraisse à la première occurence trouvée (seulement une fois)

    A voir plus tard si besoin... Je voudrai également que par "boucle C", si les informations issue de (Feuille 1 / D) sont identiques, qu'elles n'apparaissent qu'une fois mais qu'une cellule à droite d'elle (Feuille 5 / K) indique le nombre d'occurence (1 sera it aussi affiché si l'occurence est unique)

    D'avance merci

  6. #6
    Invité de passage
    Homme Profil pro
    Inscrit en
    juillet 2012
    Messages
    65
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations forums :
    Inscription : juillet 2012
    Messages : 65
    Points : 4
    Points
    4

    Par défaut

    j'ai avancé...

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    Sub Rechercher()
    Dim Plage As Range, Cel As Range, C As Range
    Dim LigneAjout As Long
    Dim firstAddress As String
       Application.ScreenUpdating = False
       With Worksheets("Stats")
        Set Plage = .Range("F2:F" & .Range("F" & Rows.Count).End(xlUp).Row)
           For Each Cel In Plage
               Set C = Worksheets("Incidents mensuels").Columns(5).Find(Cel, LookIn:=xlValues, lookat:=xlPart)
               If Not C Is Nothing Then
                   firstAddress = C.Address
                   If LigneAjout = "0" Then LigneAjout = "1" '------------------------------------------------------------------
                   Range("I" & LigneAjout + 1).Value = C '----------------------------------------------------------------------
                   Do
                       LigneAjout = .Range("J" & Rows.Count).End(xlUp).Row + 1
                       .Range("J" & LigneAjout).Value = C.Offset(0, -1)
                       Set C = Worksheets("Incidents mensuels").Columns(5).FindNext(C)
                   Loop While Not C Is Nothing And C.Address <> firstAddress
                   LigneAjout = LigneAjout + 1 '--------------------------------------------------------------------------------
               End If
           Next Cel
       End With
       Application.ScreenUpdating = True
       Set Plage = Nothing: Set Cel = Nothing: Set C = Nothing
    End Sub
    les lignes que j'ai ajoutées place bien la valeur de C à la bonne place en I mais par contre, vu que LigneAjout est calculé dans la boucle

    Code :
                       LigneAjout = .Range("J" & Rows.Count).End(xlUp).Row + 1
    Je n'arrive pas à insérer une ligne vide dans cette colonne :-(

    PS : J'ai compris d'ou venait mon message d'erreur, une des colonnes ou les données étaient prises contenait des valeurs #REF, du coup, en faisant une mise à jour "propre" de cette colonne avant de lancer la macro, plus de soucis...

    PS2: Par contre c'est super super long, on est proche des 3 minutes pour lister 1521 lignes et mon fichier final mensuel contient environ 5000-6000 lignes :-(

  7. #7
    Expert Confirmé Sénior
    Homme Profil pro
    aucune
    Inscrit en
    septembre 2011
    Messages
    6 795
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : septembre 2011
    Messages : 6 795
    Points : 12 900
    Points
    12 900

    Par défaut

    Essaie comme ceci :

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    Option Base 1
    Sub test()
        Dim Tabl1, Tabl2, Equips, Res() As String, Ctr As Long
        Ctr = 0
        ReDim Res(1)
        With Sheets("Feuille_1")
            Tabl1 = .Range(.[D1], .Cells(.Rows.Count, 4).End(xlUp))
            Tabl2 = .Range(.[E1], .Cells(.Rows.Count, 5).End(xlUp))
        End With
        With Sheets("Feuille_5")
            Equips = .Range(.[F1], .Cells(.Rows.Count, 6).End(xlUp))
        End With
        For Each Item In Equips
            For i = 1 To UBound(Tabl2)
                If Tabl2(i, 1) = Item Then
                    Ctr = Ctr + 1
                    ReDim Preserve Res(Ctr)
                    Res(Ctr) = Tabl1(i, 1)
                End If
            Next i
            Ctr = Ctr + 1
            ReDim Preserve Res(Ctr)
            Res(Ctr) = ""
        Next Item
        Sheets("Feuille_5").[J1].Resize(UBound(Res)) = Application.Transpose(Res)
    End Sub
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  8. #8
    Invité de passage
    Homme Profil pro
    Inscrit en
    juillet 2012
    Messages
    65
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations forums :
    Inscription : juillet 2012
    Messages : 65
    Points : 4
    Points
    4

    Par défaut

    Merci Daniel,

    quand je lance ta macro j'ai une pop-up

    "Erreur définie par l'application ou par l'objet"

    En regardant de plus près, l'erreur semble être liée au contenu de la cellule qui commence par =

    Code :
    ====xxxxxxxxxxxxxxxxxxxx==== Trap yyyyyyyyyyyyyyyyyyyyyy

  9. #9
    Expert Confirmé Sénior
    Homme Profil pro
    aucune
    Inscrit en
    septembre 2011
    Messages
    6 795
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : septembre 2011
    Messages : 6 795
    Points : 12 900
    Points
    12 900

    Par défaut

    Une cellule commençant par "=" est considérée comme contenant une formule. Regarde le classeur joint.
    PS. Peux-tu mettre en PJ un classeur exemple ?
    Fichiers attachés Fichiers attachés
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  10. #10
    Invité de passage
    Homme Profil pro
    Inscrit en
    juillet 2012
    Messages
    65
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations forums :
    Inscription : juillet 2012
    Messages : 65
    Points : 4
    Points
    4

    Par défaut

    j'ai transposé les === sur ton fichier car je ne peux malheureusement pas fournir l'original...

    J'ai également mis en forme le résultat que je souhaite obtenir sur la feuille 5

    Merci
    Fichiers attachés Fichiers attachés

  11. #11
    Invité de passage
    Homme Profil pro
    Inscrit en
    juillet 2012
    Messages
    65
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations forums :
    Inscription : juillet 2012
    Messages : 65
    Points : 4
    Points
    4

    Par défaut

    Une petite aide pour finaliser mon fichier ???

  12. #12
    Expert Confirmé Sénior
    Homme Profil pro
    aucune
    Inscrit en
    septembre 2011
    Messages
    6 795
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : septembre 2011
    Messages : 6 795
    Points : 12 900
    Points
    12 900

    Par défaut

    J'ai dû mettre la plage de résultats au format texte. Je peux la remettre avec un format nombre (sauf les valeurs commençant par "=") si besoin est.

    Option Base 1

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    Sub test()
        Dim Tabl1, Tabl2, Equips, Res() As String, Ctr As Long
        Ctr = 0
        ReDim Res(1)
        With Sheets("Feuille_1")
            Tabl1 = .Range(.[D2], .Cells(.Rows.Count, 4).End(xlUp))
            Tabl2 = .Range(.[E2], .Cells(.Rows.Count, 5).End(xlUp))
        End With
        With Sheets("Feuille_5")
            Equips = .Range(.[F2], .Cells(.Rows.Count, 6).End(xlUp))
        End With
        For Each Item In Equips
            For i = 1 To UBound(Tabl2)
                If Tabl2(i, 1) = Item Then
                    Ctr = Ctr + 1
                    ReDim Preserve Res(Ctr)
                    Res(Ctr) = Tabl1(i, 1)
                End If
            Next i
            Ctr = Ctr + 1
            ReDim Preserve Res(Ctr)
            Res(Ctr) = ""
        Next Item
        Sheets("Feuille_5").[J2].Resize(UBound(Res)).NumberFormat = "@"
        Sheets("Feuille_5").[J2].Resize(UBound(Res)) = Application.Transpose(Res)
    End Sub
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  13. #13
    Invité de passage
    Homme Profil pro
    Inscrit en
    juillet 2012
    Messages
    65
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations forums :
    Inscription : juillet 2012
    Messages : 65
    Points : 4
    Points
    4

    Par défaut

    nickel, plus de soucis de "===" , classement comme je le voulais, t'es un chef ^^

    Code :
    1
    2
       Sheets("Stats").[J2].Resize(UBound(Res)).NumberFormat = "@"
       Sheets("Stats").[J2].Resize(UBound(Res)) = Application.Transpose(Res)
    Ce code sert à ajuster la colonne J en largeur ? Si oui, ça ne semble pas fonctionner chez moi, mais bon, s'il n'y a plus que ça, ce n'est pas grave

    Par contre, je souhaiterai vraiment que la colonne I se remplisse avec avec la valeur recherchée (une fois par boucle si possible)

    et que la gestion des doublons soit traitée en K...

    C'est possible ou ça devient trop complexe à mettre en place ?

    Merci
    Akhlan

  14. #14
    Expert Confirmé Sénior
    Homme Profil pro
    aucune
    Inscrit en
    septembre 2011
    Messages
    6 795
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : septembre 2011
    Messages : 6 795
    Points : 12 900
    Points
    12 900

    Par défaut

    Non, la première ligne met les cellules au format texte et la seconde ajuste la plage devant recevoir le résultat à la taille de la variable Res. La variable est ensuite copiée dans cette plage.
    Pour ajuster la largeur de la colonne, ajoute en dernière ligne :

    Code :
    Sheets("Stats").[J:J].AutoFit
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  15. #15
    Invité de passage
    Homme Profil pro
    Inscrit en
    juillet 2012
    Messages
    65
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations forums :
    Inscription : juillet 2012
    Messages : 65
    Points : 4
    Points
    4

    Par défaut

    J'ai réussit à ajouter le champ "item" une fois par boucle, l'inclure dans les table aurait sans doute été plus propre mais je ne sais pas faire....

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
       Dim Tabl1, Tabl2, Equips, Res() As String, Ctr As Long
       Ctr = 0
       ReDim Res(1)
       With Sheets("Incidents mensuels")
           Tabl1 = .Range(.[D2], .Cells(.Rows.Count, 4).End(xlUp))
           Tabl2 = .Range(.[E2], .Cells(.Rows.Count, 5).End(xlUp))
       End With
       With Sheets("Stats")
           Equips = .Range(.[F2], .Cells(.Rows.Count, 6).End(xlUp))
       End With
       For Each Item In Equips
        Range("I" & Ctr + 2).Value = Item
           For i = 1 To UBound(Tabl2)
               If Tabl2(i, 1) = Item Then
                   Ctr = Ctr + 1
                   ReDim Preserve Res(Ctr)
                   Res(Ctr) = Tabl1(i, 1)
               End If
           Next i
           Ctr = Ctr + 1
           ReDim Preserve Res(Ctr)
           Res(Ctr) = ""
       Next Item
       Sheets("Stats").[J2].Resize(UBound(Res)).NumberFormat = "@"
       Sheets("Stats").[J2].Resize(UBound(Res)) = Application.Transpose(Res)
       Sheets("Stats").Columns("J:K").EntireColumn.AutoFit
    Il me reste juste le problème de redondance de la colonne J mais là, ça va de loin dépasser mes compétences en VBA...

  16. #16
    Expert Confirmé Sénior
    Homme Profil pro
    aucune
    Inscrit en
    septembre 2011
    Messages
    6 795
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : septembre 2011
    Messages : 6 795
    Points : 12 900
    Points
    12 900

    Par défaut

    Il me reste juste le problème de redondance de la colonne J mais là, ça va de loin dépasser mes compétences en VBA...
    Tu veux supprimer les doublons ?
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  17. #17
    Invité de passage
    Homme Profil pro
    Inscrit en
    juillet 2012
    Messages
    65
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations forums :
    Inscription : juillet 2012
    Messages : 65
    Points : 4
    Points
    4

    Par défaut

    oui, je voudrai supprimer les doublons mais q'un compteur s'incrémente à la ligne équivalente (en colonne K) afin de remonter le nombre d’occurrence identique pour alléger la lecture...

    Colonne I = item (une fois par boucle pour plus de clareté)
    Colonne J = info remontée de la colonne D sans doublons
    Colonne K = Nombre de répétition (le plus élevé en premier et 1 par défaut)

    J'avais mis un exemple dans l'archive "Akhlan_2.7z"

  18. #18
    Expert Confirmé Sénior
    Homme Profil pro
    aucune
    Inscrit en
    septembre 2011
    Messages
    6 795
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : septembre 2011
    Messages : 6 795
    Points : 12 900
    Points
    12 900

    Par défaut

    Ca modifie pas mal la macro. Je regarde dès que possible.
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  19. #19
    Invité de passage
    Homme Profil pro
    Inscrit en
    juillet 2012
    Messages
    65
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations forums :
    Inscription : juillet 2012
    Messages : 65
    Points : 4
    Points
    4

    Par défaut

    un grand merci

  20. #20
    Expert Confirmé Sénior
    Homme Profil pro
    aucune
    Inscrit en
    septembre 2011
    Messages
    6 795
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : septembre 2011
    Messages : 6 795
    Points : 12 900
    Points
    12 900

    Par défaut

    Ca a l'air de fonctionner. Il y a peut-être du ménage à faire. Si tu veux des explications, n'hésite pas à les demander.

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    Sub test()
        Dim Tabl1, Tabl2, Equips, Res() As String, Ctr As Long
        Dim Tabl, Dico As Object 'table double entrée
        Dim ResEquip(), ResOccur() As Long, Plage As Range
        Set Dico = CreateObject("Scripting.Dictionary")
        Ctr = 0
        ReDim Res(3, 1)
        ReDim ResEquip(1)
        ReDim ResOccur(1)
        With Sheets("Feuille_1")
            Tabl1 = Application.Transpose(.Range(.[D2], .Cells(.Rows.Count, 4).End(xlUp)))
            Tabl2 = Application.Transpose(.Range(.[E2], .Cells(.Rows.Count, 5).End(xlUp)))
            For i = 1 To UBound(Tabl1)
                If Not Dico.exists(Tabl1(i) & "***" & Tabl2(i)) Then
                    Dico.Add Tabl1(i) & "***" & Tabl2(i), Tabl1(i) & "***" & Tabl2(i)
                End If
            Next i
            For Each Item In Dico.items
                tablo = Split(Item, "***")
                Ctr = Ctr + 1
                ReDim Preserve Res(3, Ctr)
                Res(1, Ctr) = Item
                Res(2, Ctr) = tablo(1)
                Res(3, Ctr) = tablo(0)
            Next Item
        End With
        With Sheets("Feuille_5")
            .[H:K].ClearContents
            .[H2].Resize(UBound(Res, 2), 3).NumberFormat = "@"
            .[H2].Resize(UBound(Res, 2), 3) = Application.Transpose(Res)
            Set Plage = .Range(.[H2], .Cells(.Rows.Count, 10).End(xlUp))
            Plage.Sort key1:=.[I2], order1:=xlAscending, key2:=.[J2], order2:=xlAscending, Header:=xlNo
            Tabl = Application.Transpose(.Range(.[H2], .Cells(.Rows.Count, 8).End(xlUp)))
            ReDim ResOccur(Dico.Count)
            For i = 1 To UBound(Tabl1)
                Ctr = Application.Match(Tabl1(i) & "***" & Tabl2(i), Tabl, 0)
                ResOccur(Ctr) = ResOccur(Ctr) + 1
            Next
            .[K2].Resize(UBound(ResOccur)) = Application.Transpose(ResOccur)
            .[H:H].ClearContents
            Dim Final()
            ReDim Final(3, 1)
            Ctr = 0
            Tabl = Application.Transpose(.Range(.[I2], .Cells(.Rows.Count, 11).End(xlUp)))
            For i = 1 To UBound(Tabl, 2)
                    Ctr = Ctr + 1
                    ReDim Preserve Final(3, Ctr)
                    Final(1, Ctr) = Tabl(1, i)
                    Final(2, Ctr) = Tabl(2, i)
                    Final(3, Ctr) = Tabl(3, i)
                    If i < UBound(Tabl, 2) Then
                        If Tabl(1, i) <> Tabl(1, i + 1) Then
                            Ctr = Ctr + 1
                            ReDim Preserve Final(3, Ctr)
                        End If
                    End If
            Next
            For i = UBound(Final, 2) To 2 Step -1
                If Final(1, i) = Final(1, i - 1) Then Final(1, i) = ""
            Next
            .[H:K].Clear
            .[I2].Resize(UBound(Final, 2), 2).NumberFormat = "@"
            .[I2].Resize(UBound(Final, 2), 3) = Application.Transpose(Final)
        End With
    End Sub
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

+ Répondre à la discussion
Cette discussion est résolue.
Page 1 sur 2 12 DernièreDernière

Liens sociaux

Règles de messages

  • Vous ne pouvez pas créer de nouvelles discussions
  • Vous ne pouvez pas envoyer des réponses
  • Vous ne pouvez pas envoyer des pièces jointes
  • Vous ne pouvez pas modifier vos messages
  •