XL 2013 Fusionner , Sélectionner et Additionner des doublons via un programme VBA

[Anr1]

Bonjour Forum,

Je sollicite votre aide pour un obstacle en VBA cette fois-ci est un peu compliqué :

1- Colonne "E" fusionner les doublons pour une seul colonne avec:
2-Colonne "K" , si on trouve pour un doublon le mot "connaissance" alors on le laisse et on supprime le mot "malentendu"
3- Colonne de "O" jusqu'au colonne "T" : on additionne les valeurs des doublons .

Ci- joint le fichier avec un exemple de document en"Feuil1" et la solution souhaiter.


Merci d'avance

 

[Anr1]

Rebonjour Forum,

J'attend toujours une réponse .... j'ai besoin de vous svp...

Merci

 

[Marlysa]

Pourquoi vouloir du VBA? C'est faisable par des formules ou Un simple tableau croisé dynamique.

Quelques axes de solutions possibles ...
Pour les valeurs texte n'ayant pas compris la logique, je ne sais pas répondre.

 

[mapomme]

Bonsoir @anouarlachiri , @Marlysa,

Une piste en VBA. Le code est dans le module de la feuille "Feuil1"
Les résultats sont sur la feuille "Result".
Cliquer sur le bouton Hop!

Sub test()
Dim derlig&, t, d As New Dictionary, aux, i&, j&, clef, n&

derlig = Cells(Rows.Count, "e").End(xlUp).Row
t = Range("a1:t" & derlig)
d.CompareMode = TextCompare
For i = 1 To derlig
  If Not d.Exists(CStr(t(i, 5))) Then
    ReDim aux(1 To UBound(t, 2))
    For j = 1 To UBound(t, 2): aux(j) = t(i, j): Next j
    d.Add CStr(t(i, 5)), aux
  Else
    aux = d(CStr(t(i, 5)))
    For j = 15 To UBound(t, 2): aux(j) = aux(j) + t(i, j): Next j
    If LCase(t(i, 11)) = "connaissance" Then aux(11) = "Connaissance"
    d(CStr(t(i, 5))) = aux
  End If
Next i

With Worksheets("Result")
  .Activate
  For Each clef In d.Keys
    n = n + 1
    aux = d(clef)
    For j = 1 To UBound(aux): t(n, j) = aux(j): Next
  Next clef
  .UsedRange.Clear
  .Range("a1").Resize(d.Count, UBound(t, 2)) = t
  Worksheets("Feuil1").Range("a2:t2").Copy
  .Range("a2:t2").Resize(n - 1).PasteSpecial xlPasteFormats
  Application.CutCopyMode = False
  .Range("a1:t1").EntireColumn.AutoFit
End With
End Sub

 

[Anr1]

Pourquoi vouloir du VBA? C'est faisable par des formules ou Un simple tableau croisé dynamique.

Quelques axes de solutions possibles ...
Pour les valeurs texte n'ayant pas compris la logique, je ne sais pas répondre.

Merci bcp pour votre réactivité,

J'aurais besoin de garder les informations dans les autres colonne ( A,B,C...) correspondant a mes colonnes fusionner et aussi besoin de garder la même format de tableau ...

 

[Anr1]

Bonsoir @anouarlachiri , @Marlysa,

Une piste en VBA. Le code est dans le module de la feuille "Feuil1"
Les résultats sont sur la feuille "Result".
Cliquer sur le bouton Hop!

Sub test()
Dim derlig&, t, d As New Dictionary, aux, i&, j&, clef, n&

derlig = Cells(Rows.Count, "e").End(xlUp).Row
t = Range("a1:t" & derlig)
d.CompareMode = TextCompare
For i = 1 To derlig
  If Not d.Exists(CStr(t(i, 5))) Then
    ReDim aux(1 To UBound(t, 2))
    For j = 1 To UBound(t, 2): aux(j) = t(i, j): Next j
    d.Add CStr(t(i, 5)), aux
  Else
    aux = d(CStr(t(i, 5)))
    For j = 15 To UBound(t, 2): aux(j) = aux(j) + t(i, j): Next j
    If LCase(t(i, 11)) = "connaissance" Then aux(11) = "Connaissance"
    d(CStr(t(i, 5))) = aux
  End If
Next i

With Worksheets("Result")
  .Activate
  For Each clef In d.Keys
    n = n + 1
    aux = d(clef)
    For j = 1 To UBound(aux): t(n, j) = aux(j): Next
  Next clef
  .UsedRange.Clear
  .Range("a1").Resize(d.Count, UBound(t, 2)) = t
  Worksheets("Feuil1").Range("a2:t2").Copy
  .Range("a2:t2").Resize(n - 1).PasteSpecial xlPasteFormats
  Application.CutCopyMode = False
  .Range("a1:t1").EntireColumn.AutoFit
End With
End Sub

Bonjour @mapomme ,
Meeerci bcp c'est vraiment un "Hop"pour moi lol
votre programme marche parfaitement sur le dossier Test , je vais tenter ma chance sur mon dossier et je reviens vers vous au plus vite possible

 

[Anr1]

Rebonjour @mapomme,

Voilà le probléme que j'ai eu , c'est dans la première ligne "Dim derlig&, t ,d As New dictionary, aux,i&,j&,clef,n&"
Il faut fair quoi à votre avis

NB : presque 20000 lignes.

Votre programme est très bien et ça fonctionne parfaitement sur le fichier TEST je peux arriver a résoudre mon problème avec vous ..
Merci d'avance

 

[mapomme]

Re @anouarlachiri,

Bizarre. Êtes vous bien sur Excel Windows ? (et non MAC)

Essayez la version v2. J'ai remplacé la définition de l'objet d au niveau de la déclaration par une déclaration "tardive" (instruction);

En début de code :
Au lieu de :

Sub test()
Dim derlig&, t, d As New Dictionary, aux, i&, j&, clef, n&

derlig = Cells(Rows.Count, "e").End(xlUp).Row
t = Range("a1:t" & derlig)
d.CompareMode = TextCompare

on a codé :

Sub test()
Dim derlig&, t, d, aux, i&, j&, clef, n&

derlig = Cells(Rows.Count, "e").End(xlUp).Row
t = Range("a1:t" & derlig)
Set d = CreateObject("scripting.dictionary")
d.CompareMode = TextCompare

 

[Anr1]

@mapomme

Oui j'ai Excel Windows et j'ai essayé votre deuxième code et ça marche très bien comme je voulais exactement juste que le premier doublon est au colonne "k" ligne 4 et 5 le programme ils prend pas que le mont "connaissance " il a pris le mot " malentendu" et quelques autres observations je sait pas pourquoi .... cette condition est pas tjrs respecter

 

[Anr1]

@mapomme

J'aimerais bien que chaque fois le mot "connaissance" s'affiche dans un doublons alors le programme prend que ce mot là ...
et c'est le cas de votre programme mais ya des observations le cette condition marche pas.

Merci

 

[mapomme]

Re,

Il me faudrait un échantillon avec des exemples où ça ne marche pas...

 

[Anr1]

Re,

Merci pour votre réponse
voilà ci-joint vous trouverez le fichier j'ai essayé de créer une petite exemple

 

[mapomme]

Re,

Dans ma version v1 et v2, j’avais écrit :

If LCase(t(i, 11)) = "connaissance" Then aux(11) = "Connaissance"

avec un "c" minuscule pour la première lettre du premier mot "connaissance"

Dans votre version Test_verifier1.xlsm, on trouve à la place cette instruction :

If LCase(t(i, 11)) = "Connaissance" Then aux(11) = "Connaissance"

avec un "C" MAJUSCULE pour la première lettre du premier mot "connaissance"

C'est ce qui explique le comportement bizarre de votre version.

 

[Anr1]

Rebonjour,

Ah ok apparemment c'est ça le problème je viens de vérifier sur mon programme et ça marche bien maintenant grâce à vous

Merciiiii Bien @mapomme pour m'accorder votre temps

@+

 

[Anr1]

@mapomme,

Je me permets de vous demandez si c'est possible de m’écrire des commentaire sur le programme pour que je puisse le comprendre mieux.

NB: je suis débutant en VBA alors juste pour améliorer mon niveau si vous pouvez m'aider et si c'est possible bien sur