IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

VBA_Suppression & addition_Doublons [XL-2016]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre averti
    Homme Profil pro
    Chargé d'affaire
    Inscrit en
    Janvier 2016
    Messages
    34
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Haute Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Chargé d'affaire

    Informations forums :
    Inscription : Janvier 2016
    Messages : 34
    Par défaut VBA_Suppression & addition_Doublons
    Bonjour le forum!

    Après quelques jours de recherches et d'essais non concluants, je viens poser ma question qui concerne un point précis de la gestion des doublons en VBA.

    Mon problème est le suivant:
    - je dois supprimer des doublons dans certaines colonnes et additionner les valeurs dans d'autres colonnes si les premières colonnes ont été détectées en tant que doublons,
    - les données en double peuvent être à n'importe quelle ligne dans la feuille de calcul,
    - seules les données en doublon d'une colonne (dans l'exemple ici la colonne A) sont déterminants pour déclencher l'action,
    - cette opération doit être légère, car elle est intégrée à un autre code.

    Mon cas donnerait ainsi à peu près cela (avant / après):

    A B C D
    Donnée1 Donnée1.1 10 34
    Donnée1 Donnée1.1 26 52
    Donnée2 Donnée2.1 20 26
    Donnée1 Donnée1.1 10 2


    A B C D
    Donnée1 Donnée1.1 46 88
    Donnée2 Donnée2.1 20 26


    J'ai lu par exemple quelques fils faisant référence à la méthode Highlander développée par rdurupt, mais j'avoue ne pas avoir réussi à l'adapter à mon cas précis.

    N'hésitez pas à me demander plus d'informations sur le cas si celui-ci n'est pas assez détaillé.


    Bonne journée à tous!

    Esculape.

  2. #2
    Membre expérimenté
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Février 2016
    Messages
    102
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 63
    Localisation : France, Haute Garonne (Midi Pyrénées)

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : Février 2016
    Messages : 102
    Par défaut Sommer et eliminer doublons
    Bonjour,

    Je te suggère ce type de code pour traiter la liste... Tri sur colonne A puis 2 boucles imbriquées. Pas trop lourd !

    Encore une fois, pour les pros VBA, y a bien sûr plus efficace mais l'objectif est aussi d'être pédagogue...

    Cordialement.

    Bruno

    ElimineDoublonsAvec Somme.xlsm

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
     
    Option Explicit
     
    Sub SommeDoublons()
    Dim Cumul1 As Long
    Dim Cumul2 As Long
    Dim Groupe As String
     
    'Fige écran
    Application.screenupdating=false
     
    'Tri par Groupe
        Range("A16").Select
        ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("A15"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Feuil1").Sort
            .SetRange Range("A15:D" & Range("A15").End(xlDown).Row)
            .Header = xlYes
            .Apply
        End With
    'Traite doublons
    Range("A16").Activate
    Do While ActiveCell <> "" 'Parcours toute la liste
        Groupe = ActiveCell
        Cumul1 = ActiveCell.Offset(0, 2)
        Cumul2 = ActiveCell.Offset(0, 3)
     
        Do While ActiveCell.Offset(1, 0) = Groupe 'Tant qu'il existe un doublon sur Groupe
            'Cumuler valeurs
            Cumul1 = Cumul1 + ActiveCell.Offset(1, 2)
            Cumul2 = Cumul2 + ActiveCell.Offset(1, 3)
            'Supprimer le doublon
            ActiveCell.Offset(1, 0).EntireRow.Delete
        Loop
        'Reporter cumuls sur ligne restante
        ActiveCell.Offset(0, 2) = Cumul1
        ActiveCell.Offset(0, 3) = Cumul2
     
        'Passer au groupe suivant
        ActiveCell.Offset(1, 0).Select
    Loop
     
    End Sub

  3. #3
    Membre Expert
    Homme Profil pro
    PAO
    Inscrit en
    Octobre 2014
    Messages
    2 576
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : PAO
    Secteur : Communication - Médias

    Informations forums :
    Inscription : Octobre 2014
    Messages : 2 576
    Par défaut
    Bonjour,
    Sur excel sa ressemble à la formule sommeprod : résultat en 6è et 7è ligne du tableau
    Donnée1 Donnée1.1 10 34
    Donnée1 Donnée1.1 26 52
    Donnée2 Donnée2.1 20 26
    Donnée1 Donnée1.1 10 2
    A B C D
    Donnée1 Donnée1.1 46 88 =SOMMEPROD((A1:A4=A3)*(B1:B4=B3);(C1:C4)) =SOMMEPROD((A1:A4=A1)*(B1:B4=B1);(D1: D4))
    Donnée2 Donnée2.1 20 26 =SOMMEPROD((A1:A4=A3)*(B1:B4=B3);(C1:C4)) =SOMMEPROD((A1:A4=A3)*(B1:B4=B3);(D1: D4))
    j'ai commencé un post sur les doublons qui pourrait te servir : http://www.developpez.net/forums/d15...ns-specifique/
    En te basant en vba sur le principe de sommeprod tu pourrais sauvegarder la somme de tous les (Donnée1, Donnée1.1) et tous les (Donnée2, Donnée2.1) … avec une recherche des doublons, stockage de leurs somme, suppression des doublons puis copier les sommes sur les occurences correspondantes

    désolé je n'ai pas vraiment le temps de faire qq chose en vba (cause mon post me prends déjà bcp de temps) mais je pense que la solution est proche de ce que tu peux trouver dans mon post
    cordialement

    re,

    en vba schématiquement on aurait (désolé si c'est pas très bien formulé) :

    • Recherche des doublons de (Col A(i) et Col B(i)) dans ta plage
    • pour chaque doublons trouvés, stock les valeurs de (col C(i), Col D(i))
    • qd le scan de ta plage est terminé, suppression des doublons
    • et faire correspondre la somme des doublons pour (Col A(i) et Col B(i)) en (col C(i), Col D(i))
    (les autres données n'ayant pas de doublons, resteront avec leurs valeurs)
    Cordialement
    Ryu

    La connaissance s’acquiert par l’expérience, tout le reste n’est que de l’information. – Albert Einstein

    Pensez à la Balise [ CODE][/CODE ] - à utiliser via le bouton # => Exemple

    Une fois votre problème solutionné pensez à mettre :resolu: en n'oubliant pas d'indiquer qu'elle est la solution finale choisie ;)

  4. #4
    Invité
    Invité(e)
    Par défaut
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Sub SupprimerDoublon()
    Dim Init As Boolean
    Dim MyRange As Range
    Dim L As Long
    Dim I As Long
    Dim lignes() As Long
    Set MyRange = ActiveSheet.UsedRange
    Debug.Print "Sur  colonne A"
    For L = 1 To MyRange.Rows.Count
       If Highlander(Init, MyRange(L, 1)) = True Then
        ReDim Preserve lignes(I)
        lignes(I) = L
        I = I + 1
       End If
    Next
     
    For I = UBound(lignes) To 0 Step -1
        MyRange(lignes(I), 1).EntireRow.Delete
    Next
    End Sub
    Function Highlander(Init As Boolean, ParamArray Plage()) As Boolean
    '..................................................
    'La méthode Highlander, il ne peut en rester qu'un.
    'Retourne True si doublon.
    '..................................................
     
    Static CollectDoublon As Collection
    Dim T As String
    Dim PlageIndex As Long
    Dim myPlage As Range
    Dim Col As Integer
    If Init = False Then
    Init = True
       Set CollectDoublon = Nothing
       Set CollectDoublon = New Collection
    End If
     
     
    T = "T"
    For PlageIndex = 0 To UBound(Plage)
       Set myPlage = Plage(PlageIndex)
       For Col = 1 To myPlage.Columns.Count
        T = T & "_" & myPlage(1, Col)
       Next
    Next
    On Error Resume Next
    CollectDoublon.Add T, T
    If Err <> 0 Then Highlander = True
    On Error GoTo 0
    End Function
    Sub DeleteRow(MyRange As Range)
    Dim DelRow As String
    DelRow = CStr(MyRange.Row) & ":" & CStr(MyRange.Row)
    Debug.Print DelRow
        ActiveSheet.Rows(DelRow).Delete Shift:=xlUp
     
     
    End Sub

  5. #5
    Expert éminent
    Avatar de Marc-L
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Avril 2013
    Messages
    9 468
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Avril 2013
    Messages : 9 468
    Par défaut
    Bonjour, bonjour !

    Citation Envoyé par Esculape Voir le message
    - cette opération doit être légère, car elle est intégrée à un autre code.
    Elle ne le sera pas forcément, tout dépend déjà de l'intelligence de conception de la feuille de calculs contenant les données !

    Joindre un classeur exemple en .xlsx (sans code donc) contenant une feuille avant et une feuille après
    en précisant si les données doivent remplacer celles de la feuille source ou alimenter une autre feuille …

    ______________________________________________________________________________________________________
    Je suis Paris, Charlie, …

  6. #6
    Membre averti
    Homme Profil pro
    Chargé d'affaire
    Inscrit en
    Janvier 2016
    Messages
    34
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Haute Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Chargé d'affaire

    Informations forums :
    Inscription : Janvier 2016
    Messages : 34
    Par défaut
    Merci pour ces réponses!

    J'ai testé le code ZX12R, mais je bloque sur quelques points. Le débogueur me dit que As Long de Cumul2 ne convient pas. Cela marche avec un String (peut-être trop vaste comme définition?).
    Mais je n'obtiens toujours pas une addition des deux dernières colonnes si doublon.


    • Recherche des doublons de (Col A(i) et Col B(i)) dans ta plage
    • pour chaque doublons trouvés, stock les valeurs de (col C(i), Col D(i))
    • qd le scan de ta plage est terminé, suppression des doublons
    • et faire correspondre la somme des doublons pour (Col A(i) et Col B(i)) en (col C(i), Col D(i))
    (les autres données n'ayant pas de doublons, resteront avec leurs valeurs)
    Voilà c'est ça RyuAutodidacte. Sauf que je n'aurais même besoin que de ce qui est présent dans la Colonne A.


    Merci rdurupt pour l'adaptation du code. Cependant il semble boucler sans fin à la suite du Next ici...
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    For I = UBound(lignes) To 0 Step -1
        MyRange(lignes(I), 1).EntireRow.Delete
    Next
    End Sub

    Marc-L, merci de ta réponse, je te ferai parvenir ce fichier demain dans la matinée pour que tu puisses cerner le problème.


    Bonne soirée le forum!

    Esculape.


    P.S.: Je ne pourrai répondre que demain dans la matinée.

  7. #7
    Membre averti
    Homme Profil pro
    Chargé d'affaire
    Inscrit en
    Janvier 2016
    Messages
    34
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Haute Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Chargé d'affaire

    Informations forums :
    Inscription : Janvier 2016
    Messages : 34
    Par défaut
    Bonjour le forum!


    Pris par le temps, je n'ai pas pu répondre ce matin.
    Mais voici le fichier d'exemple promis: Exemple suppression doublons.xlsx

    L'idée est donc d'additionner le résultat, lorsqu'il s'agit de doublons, des colonnes C et D tout en supprimant le contenu en doublon des cellules A, B et C.


    Esculape.

  8. #8
    Expert éminent
    Avatar de Marc-L
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Avril 2013
    Messages
    9 468
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Avril 2013
    Messages : 9 468
    Par défaut P'tite démonstration !
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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 Demo()
            VA = Feuil1.Cells(1).CurrentRegion.Value
            If UBound(VA, 2) < 5 Then Beep: Exit Sub
            ReDim VR(1 To UBound(VA), 1 To 5)
            For C% = 1 To 5:  VR(1, C) = VA(1, C):  Next
        With CreateObject("Scripting.Dictionary")
            For R& = 2 To UBound(VA)
                If .Exists(VA(R, 2)) Then
                          L& = .Item(VA(R, 2))
                    VR(L, 4) = VR(L, 4) + VA(R, 4)
                    VR(L, 5) = VR(L, 5) + VA(R, 5)
                Else
                    L = .Count + 2
                    .Add VA(R, 2), L
                    For C = 1 To 5:  VR(L, C) = VA(R, C):  Next
                End If
            Next
                 Feuil2.UsedRange.Clear
            With Feuil2.[A1:E1].Resize(.Count + 1)
                .Value = VR
                .Columns.AutoFit
                Application.Goto .Cells(1), True
            End With
                .RemoveAll
        End With
    End Sub
    ______________________________________________________________________________________________________

    Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

  9. #9
    Membre averti
    Homme Profil pro
    Chargé d'affaire
    Inscrit en
    Janvier 2016
    Messages
    34
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Haute Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Chargé d'affaire

    Informations forums :
    Inscription : Janvier 2016
    Messages : 34
    Par défaut
    Génial Marc-L ça marche super!!

    Je tente de l'adapter ce soir (copie sur même feuille notamment) et je vous tiens au courant.
    Merci de votre réactivité!!

    Bonne soirée,

    Esculape.

+ Répondre à la discussion
Cette discussion est résolue.

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo