Macro suppression doublons

Athina -  
 Athina -
Bonjour à tous,

J'ai quelques notions de VBA, mais pas assez pour ce que je veux faire.

Voici le problème:

1) J'ai un tableau avec trois colonnes "A"=Nombresx "B"=Datesy "C"=Datesz et des milliers de lignes.

2) Il faut, comparer trier grouper la col."A" par valeur identique (jusque là tout va bien...)

3) Pour chaque ligne groupé par col"A" il faut trouver dans ce groupe dans la col"B" la date la plus basse et dans la col."C" la date la plus haute. (et ce pour chaque groupe)

4) Supprimer les lignes de ce groupe en gardant la date col."B" la plus basse et la col."C" la plus haute du groupe.

un GRAND MERCI à celui ou ceux qui ont une solution et qui sont prêt a m'aider ;-)
Configuration: Windows XP Internet Explorer 7.0

7 réponses

  1. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    bonsoir,

    afin de choisir une méthode(vba,matricielle, sommeprod, basededonnées...), combien as tu de "valeursx " différentes (environ, bien sûr) ?
    je verrai tout ça à la fraiche demain matin...
    0
  2. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    bonjour,

    c'est fait par VBA: environ 3/10 seconde pour trier et donner la liste nombrex, datey mini, datez maxi sur une maquette de 12000 lignes...
    J'attends un coucou de d'Athina pour fournir la solution.
    (Syndrome de la demande du vendredi hélas très courant: je pars en WE, faites-moi ca pendant le votre pour lundi matin où je regarderais vos oeuvres, ou peut-être dimanche soir après la télé... ==> cherches toi-même au bureau lundi)

    méthode utilisée:
    tri sur 2 colonnes (nombrex puis datey en croissant)
    détermination du nombre (nbre) de valeurs uniques (par objet dictionnary)
    rangement des valeurs demandées à partir d'un autre objet dictionary dans un tableau de type (nbre,2)
    restitution du tableau en feuille par la méthode resize
    0
  3. Athina
     
    Bonsoir Michel,

    Merci de t'interesser a mon cas ;-) pour les valeursX en moyenne 1'000. (donc avec 12'000 cela devrait être plus que bon).

    Serait-il possible que tu me fournisse la Macro????? Ce serait super sympas....car en lisant ta réponse je n'ai pas (tout) compris (mes notions VBA sont un brin mieux que basique, c'est tout...)

    Merci encore pour ton aide.
    0
  4. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    OK, Bonsoir,
    ci dessous la procédure

    Option Explicit
    
    Sub selectionner_minimaxi()
    Dim derlig As Long, cptr As Long, nbre As Long, cptr_tablo As Long, nbre_ref As Long
    Dim ref As Single
    Dim dico_ref As Object
    Dim tablo()
    
    'préparation
    Application.ScreenUpdating = False
    derlig = Range("A65536").End(xlUp).Row
    Set dico_ref = CreateObject("Scripting.Dictionary")
    Sheets(2).Range("A2:C65536").ClearContents
    
    Sheets(1).Activate
        'trie les nombresx puis les datesy dans l'orde croisssant
    '   ==> la datey la + basse est sur la m^ ligne après changement de nombre
        derlig = Range("A65536").End(xlUp).Row
        Range("A1:C" & derlig).Sort Key1:=Range("A2"), Key2:=Range("B2"), header:=xlGuess
        
    'compte le nombre de valeurs uniques
    For cptr = 2 To derlig
        ref = Cells(cptr, 1)
        If Not dico_ref.Exists(ref) Then
                dico_ref.Add ref, ref
        End If
    Next
     nbre = dico_ref.Count
    Set dico_ref = Nothing
    ReDim tablo(nbre, 2)
    
    Set dico_ref = CreateObject("Scripting.Dictionary")
    For cptr = 2 To derlig
        ref = Cells(cptr, 1)
        If Not dico_ref.Exists(ref) Then
                dico_ref.Add ref, ref
            'alimente le tableau nombrex, datey, datez
                tablo(cptr_tablo, 0) = ref
                tablo(cptr_tablo, 1) = Cells(cptr, 2) 'datey
                'recherche le nombre de ref pour trouver datez maxi
                    nbre_ref = Application.CountIf(Range("A2:A" & derlig), ref)
               '    affecte le tableau de la datez maxi
                    tablo(cptr_tablo, 2) = Application.Max(Range(Cells(cptr, 3), Cells(nbre_ref + cptr - 1, 3)))
                    
                'incrémente le compteur tablo
                cptr_tablo = cptr_tablo + 1
        End If
    Next
    
    Sheets(2).Activate
    Range("A2").Resize(nbre, 3) = (tablo)
    Columns("A:A").NumberFormat = "General"
    Columns("B:C").NumberFormat = "dd/mm/yy;@"
        
    End Sub


    et la maquette sur laquelle j'ai travaillé:
    https://www.cjoint.com/?iwwSViTHD4

    le bouton" initialiser" te remplit 10000 lignes avec 500 valeurs uniques (c'est un peu long). tu peux modifier avec + ou - de lignes et de valeursx
    le bouton "chercher mini maxi" te liste en feuil2 les valeurs uniques en col a avec en col B la datey mini et en col C la datez maxi pour la valeur
    le bouton "chronometrer" exécute la procédure et indique le temps pour l'effectuer. chez moi, avec 512 Mo de ram et celeron 1,9 Go j'ai 1,48 seconde

    tu dis...
    0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. Athina
     
    Je dis...BRAVO Michel....Merci du temps passé et pour ta rapidité de réponse, MAIS...

    Mon déscriptif n'était surement pas claire...et j'èspère que tu auras la patience de me répondre ;-)

    Grpe Mini Maxi
    1293 21.05.07 11.12.08 =(Données)
    1293 20.05.07 18.01.09 =(Données)
    1293 27.05.08 03.03.09 =(Données)
    1293 16.04.08 01.05.07 =(Données)
    1293 13.03.09 05.11.06 =(Données)

    1293 20.05.07 03.03.09 =(résultat désiré du groupe)

    1211 04.07.09 07.05.07 =(Données)
    1211 21.06.07 12.07.08 =(Données)
    1211 25.04.09 20.11.08 =(Données)

    1211 21.06.07 20.11.08 =(résultat désiré du groupe)

    NB: les dates, après le passage de la MACRO, sont parfois en format standard et parfois inversé?!?
    1266 10/18/2006 01.07.09
    1267 04.06.07 20.05.09

    Un GRAND MERCI d'avance (et la vitesse de traitement et TOP)
    0
  7. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Désolé mais je teste toujours chez moi (voir maquette) avant d'envoyer une proposition et correspond bien à ce que tu demandais...

    par ex:
    1001 27/11/06 22/07/07
    1001 18/01/07 06/07/07
    1001 08/02/07 18/07/08
    1001 10/08/07 07/12/06
    1001 20/10/07 08/11/07
    1001 13/12/07 30/03/08
    1001 19/06/08 18/01/07

    renvoie bien
    1001 27/11/06 18/07/08

    la différence doit provenir chez toi de date au format anglo-saxon "mm/dd/yy" (vu l'heure, peut-^tre le Québec ?)

    la mise au format est effectuée par les 2 dernières lignes de la procédure:

    Columns("A:A").NumberFormat = "General"
    Columns("B:C").NumberFormat = "dd/mm/yy;@"

    a toi d'adapter( utilise l'enregistreur de macro)

    0
  8. Athina
     
    Bonjour Michel,

    Mille excuses d'avoir mis en doute ce que tu avais fait, l'erreur était bien chez moi, trop d'empressement dans mes propres tests...
    Tout fonctionne a merveille, MERCI encore pour ton aide très appréciable...et pour ta patience...
    A bientôt.
    0