Fusion de ligne si doublon par macro

citizenbaban · 28 Mars 2013

Bonjour à tous,

J'ai un petit problème avec une macro. Voici l'idée :
Je voudrais fusionner des lignes de B à H, si et seulement si, des dates en colonne A sont identiques sur plusieurs lignes.
Par exemple :

12/03/13 50 60 "vide" 10
12/03/13 50 60 "vide" 10
12/03/13 "vide" "vide" 100 "vide"

Donnerait :
12/03/13 50 60 100 10

En me balladant ici et ailleurs, j'ai trouvé un code qui fonctionne bien pour ce que la personne recherchait, mais pour être honnête, je ne le comprend pas ^^ Du coup ça serait surtout pour avoir quelques explications sur ce code, à quel chiffre correspond les colonnes, les lignes, etc. Car même en tatonnant, je n'obtiens que des résultats bizarres ^^

Voici le code :

Code:

Sub Groupage()
Dim Col As Integer, Lg As Long, nLg As Byte, Nom As String
Application.ScreenUpdating = False
Nom = Cells(2, 2): Lg = 2
While Nom <> ""
  While Cells(Lg, 2).Offset(nLg, 0) = Nom
    nLg = nLg + 1
    For Col = 3 To 7
      If Cells(Lg, Col) = "" Then
        Cells(Lg, Col) = Cells(Lg, Col).Offset(nLg, 0)
      End If
    Next
  Wend
  Lg = Lg + nLg
  Nom = Cells(Lg, 2)
  nLg = 0
Wend
For Lg = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
  If Application.WorksheetFunction.CountIf(Feuil1.Range("B:B"), Cells(Lg, 2).Value) > 1 Then
    Rows(Lg).EntireRow.Delete
  End If
Next
Application.ScreenUpdating = True
End Sub

Je ne sais plus ou je l'ai récupéré, donc si quelqu'un reconnait son code, désolé pour l'absence de référence 🙂

Merci beaucoup.
Citizen

job75 · 29 Mars 2013

Re : Fusion de ligne si doublon par macro

Bonjour citizenbaban, le fil,

Ma macro (1) du post #10 ne sera pas du tout rapide sur un grand tableau, en effet :

- Application.CountIf prend beaucoup de temps

- il faut traiter des tableaux VBA et non pas des plages.

Voici donc la macro qui va bien, elle utilise au mieux l'objet "Dictionary" :

Code:

Sub Regrouper()
Dim plage As Range, tablo, ncol%, d As Object, i&, t$(), j%
Set plage = Sheets("Données").UsedRange
If plage.Count = 1 Then Exit Sub 'sécurité
plage.Sort plage(1), xlAscending, Header:=xlYes 'tri avec en-têtes
tablo = plage.Resize(Application.Count(plage.Columns(1)) + 2).Value2
ncol = UBound(tablo, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo) - 1
  If Not d.exists(tablo(i, 1)) Then
    d(tablo(i, 1)) = ""
    ReDim t(1 To ncol) 'RAZ
  End If
  For j = 1 To ncol
    If tablo(i, j) <> "" Then t(j) = tablo(i, j)
  Next
  If Not d.exists(tablo(i + 1, 1)) Then d(tablo(i, 1)) = Join(t, Chr(1))
Next
'---restitution---
With Sheets("Résultats")
  .Cells.ClearContents
  .[A1].Resize(d.Count) = Application.Transpose(d.items)
  Application.DisplayAlerts = False
  .[A:A].TextToColumns .[A1], xlDelimited, Other:=True, OtherChar:=Chr(1)
  .Activate
End With
End Sub

Fichier (2).

A+

citizenbaban · 29 Mars 2013

Re : Fusion de ligne si doublon par macro

Bonjour Job75, le fil

Comment dire...c'est beau 🙂
Ca marche tip-top et je pense avoir compris le code dans ses grands axes. (Le code de Thierry m'a aidé à bien comprendre 2-3 points un peu flous pour moi).
Je vais me plonger dedans pour le comprendre en détail maintenant, ça restera le meilleur moyen pour restituer, un jour, un peu de ce qui m'a été donné ici.

Merci à tous. Problème résolu (comme toujours ici 🙂 )
Bonne journée à tous

Citizen

job75 · 29 Mars 2013

Re : Fusion de ligne si doublon par macro

Re citizenbaban,

Je suis content que ma macro vous convienne.

Pour info je l'ai testée avec le tableau recopié sur 60000 lignes (nouvelles dates sans doublon).

Sur Win XP - Excel 2003 elle s'exécute en 5,3 secondes.

A+

BOISGONTIER · 29 Mars 2013

Re : Fusion de ligne si doublon par macro

Bonjour,

La table Tbl() est indexée par le dictionnaire pour accéder plus rapidement aux lignes du tableau.

Code:

Sub Stat2DCumul()
  Set d1 = CreateObject("Scripting.Dictionary")
  Set f1 = Sheets("données")
  ncol = f1.[a1].CurrentRegion.Columns.Count
  Dim Tbl()
  ReDim Tbl(1 To 1000, 1 To ncol)
  ligT = 1
  MaxligT = ligT
  a = f1.[a1].CurrentRegion
  For ligne = 2 To UBound(a)
    crit = a(ligne, 1)
    If d1.exists(crit) Then ligT = d1(crit) Else d1(crit) = MaxligT: ligT = MaxligT: MaxligT = MaxligT + 1
    For col = 2 To ncol
      If a(ligne, col) <> "" Then Tbl(ligT, col - 1) = Tbl(ligT, col - 1) + Val(a(ligne, col))
    Next col
  Next ligne
  Set f2 = Sheets("résultats")
  f1.[a1].Resize(, ncol).Copy f2.[a1]
  f2.[a2].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
  f2.[B2].Resize(d1.Count, ncol - 1) = Tbl
End Sub

JB

job75 · 30 Mars 2013

Re : Fusion de ligne si doublon par macro

Bonjour citizenbaban, JB, le fil,

J'ai voulu voir ce que ça donnait sans "Dictionary" :

Code:

Sub Regrouper()
Dim plage As Range, tablo, ncol%, t(), lig&, i&, dat, j%
Set plage = Sheets("Données").UsedRange
If plage.Count = 1 Then Exit Sub 'sécurité
plage.Sort plage(1), xlAscending, Header:=xlYes 'tri avec en-têtes
tablo = plage.Resize(Application.Count(plage.Columns(1)) + 2).Value2
ncol = UBound(tablo, 2)
ReDim t(1 To UBound(tablo), 1 To ncol)
lig = 1
For i = 1 To UBound(tablo) - 1
  dat = tablo(i, 1): t(lig, 1) = dat
  While tablo(i, 1) = dat
    For j = 2 To ncol
      If tablo(i, j) <> "" Then t(lig, j) = tablo(i, j)
    Next
    i = i + 1
  Wend
  lig = lig + 1
  i = i - 1
Next
'---restitution---
With Sheets("Résultats")
  .Cells.ClearContents
  .[A1].Resize(lig - 1, ncol) = t
  .Activate
End With
End Sub

Noter que Application.Transpose n'est plus utilisée.

Fichier (3).

Eh bien sur le tableau de 60000 lignes la durée d'exécution se réduit à 2,1 secondes.

Et la macro de JB s'exécute en 3,7 secondes.

Comme quoi "Dictionary" n'est pas forcément la panacé.

A+

BOISGONTIER · 30 Mars 2013

Re : Fusion de ligne si doublon par macro

Bonjour,

Je faisais l'hypothèse que l'on ne touchait pas au tableau d'origine qui n'est pas nécessairement trié.
Le dictionnaire d1 indexe le tableau Tbl(,) permettant ainsi de retrouver rapidement la bonne ligne du tableau Tbl(,) pour effectuer le cumul.
Ce n'est pas Dictionary qui est en cause, mais la méthode utilisée.
Une recherche d'une clé dans un dictionnaire est 100 fois plus rapide qu'une recherche dans un tableau de taille importante.

JB

job75 · 30 Mars 2013

Re : Fusion de ligne si doublon par macro

Re JB,

Avec ma dernière macro rien n'empêche de copier le tableau d'origine dans la 2ème feuille et d'y faire le tri :

Code:

Sub Regrouper()
Dim plage As Range, tablo, ncol%, t(), lig&, i&, dat, j%
Set plage = Sheets("Données").UsedRange
If plage.Count = 1 Then Exit Sub 'sécurité
With Sheets("Résultats")
  .Cells.ClearContents
  plage.Copy .[A1]
  Set plage = .UsedRange
  plage.Sort plage(1), xlAscending, Header:=xlYes 'tri avec en-têtes
  tablo = plage.Resize(Application.Count(plage.Columns(1)) + 2).Value2
  ncol = UBound(tablo, 2)
  ReDim t(1 To UBound(tablo), 1 To ncol)
  lig = 1
  For i = 1 To UBound(tablo) - 1
    dat = tablo(i, 1): t(lig, 1) = dat
    While tablo(i, 1) = dat
      For j = 2 To ncol
        If tablo(i, j) <> "" Then t(lig, j) = tablo(i, j)
      Next
      i = i + 1
    Wend
    lig = lig + 1
    i = i - 1
  Next
  '---restitution---
  .Cells.ClearContents
  .[A1].Resize(lig - 1, ncol) = t
  .Activate
End With
End Sub

Sur 60000 lignes la durée d'exécution passe à 2,3 secondes.

A+

job75 · 30 Mars 2013

Re : Fusion de ligne si doublon par macro

Re JB,

BOISGONTIER à dit:
Une recherche d'une clé dans un dictionnaire est 100 fois plus rapide qu'une recherche dans un tableau de taille importante.

Bien d'accord avec toi, mais en l'occurence si le tableau est trié il n'y a rien à rechercher.

Je constate simplement que la création du "Dictionary" prend du temps.

A+

citizenbaban · 17 Avril 2013

Re : Fusion de ligne si doublon par macro

Bonjour à tous,

Désolé pour cette longue absence mais j'ai eu droit à un déplacement professionnel au dernier moment et j'ai été pas mal pris. J'ai bien intégré ta modif Job, c'est royal 🙂
J'ai un autre petit souci de mise en forme sur fichier mais pour un tout autre problème, je vais ouvrir un nouveau topic car je pense que ça pourra aider certaines personnes sur les problèmes de barres de seuil sur des graphiques 🙂

Bonne journée à tous et peut être a très vite sur le nouveau topic.

Citizen

nicogif · 17 Avril 2013

Re : Fusion de ligne si doublon par macro

Salut à tous,

J'ai lu avec attention tout ça car concerné par le meme soucis, toutes les réponses m'ont évidemment fortement intéressé mais mes limitations en VBA ont eu definitivement raison de moi.

Alors j'ai investigué le truc seul en me disant que les TCD pourraient m'aider...

Et j'ai trouver la solution ! Je suis en Excel 2010 PC Je partage avec ceux que ca intéresse mon fichier exemple ! La source est sur la feuille 1 le TCD sur la feuille 2

Après la solution devellopeur... Voici la solution Utilisateur, peut etre un poil plus accessible...

_Thierry · 18 Avril 2013

Re : Fusion de ligne si doublon par macro

Bonsoir le Fil, le Forum

Welcome to XLD NicoGif

Et bien vu ta solution TCD pour un premier Post, c'est chouette de tenter de donner un réponse.

@+Thierry

Effectuez une recherche sur Excel Downloads...

Fusion de ligne si doublon par macro

citizenbaban

XLDnaute Junior

job75

XLDnaute Barbatruc

Pièces jointes

citizenbaban

XLDnaute Junior

job75

XLDnaute Barbatruc

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

BOISGONTIER

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

citizenbaban

XLDnaute Junior

nicogif

XLDnaute Nouveau

Pièces jointes

_Thierry

XLDnaute Barbatruc

Discussions similaires

Nous accordons de l'importance à votre vie privée