fusionner doublons vba

Version imprimable

07/04/2018, 17h17
chocho1990

1 pièce(s) jointe(s)

fusionner doublons vba

bonjour j'espere que vous allez bien .

j'ai un probleme de doublons dans mon fichier excel

je voudrias fussioner les cellules doublons par collonnes par exemple collonne 1 ,2,3 ...

et des collones que je veux pas les fusionner psk ils contiennent les codesn client et la quantité qui sont colloriser en jaune dans mon fichier joint

si il y'a une proposition ça serait bien et merci .Pièce jointe 368151

1 pièce(s) jointe(s)

j'ai deja esseyer de faire une petite macro mais juste pour une seule ligne .voila mon code:

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
Sub Fusion_Cellules()
 
 
Dim cel As Range
Dim i As Integer
Dim c As Integer
 
  With Selection
    If .Rows.Count > 1 And .Columns.Count > 1 Then
      MsgBox ("Vous ne pouvez pas sélectionner SIMULTANEMENT :" & Chr(13) _
               & Chr(13) & "                           Plusieurs Lignes" _
               & Chr(13) & "                                    ET" _
               & Chr(13) & "                         Plusieurs Colonnes")
      Exit Sub
    Else
        For Each cel In .Cells
          If LCase(cel.Text) <> "" Then
            i = 0
            Application.DisplayAlerts = False
            If .Columns.Count = 1 Then
              Do While cel.Offset(i, 0).Text = cel.Offset(i + 1, 0).Text
                i = i + 1
              Loop
              With Range(cel, cel.Offset(i, 0))
                  .VerticalAlignment = xlTop
                  .MergeCells = True
              End With
            Else
              Do While cel.Offset(0, i).Text = cel.Offset(0, i + 1).Text
                i = i + 1
              Loop
              Application.DisplayAlerts = False
              With Range(cel, cel.Offset(0, i))
                  .MergeCells = True
              End With
            End If
            Application.DisplayAlerts = True
          End If
        Next cel
    End If
  End With
 
End Sub

et voila mon fichier joint.

Pièce jointe 368160

bonsoir chocho
je pense qu'il faut trier dans l'ordre avant et reperer les doublons apres
pour tes lignes en doublons colonne par colonne

test ca et regarde dans la fenetre d'execution

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub test()
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("res").Delete
    Err.Clear
    Dim dico As Object
    Set dico = CreateObject("scripting.dictionary")
    mescol = Array(2, 3, 4, 5, 6, 12, 13)
    Sheets("Feuil1").Copy After:=Sheets(Sheets.Count)
    Set sh = Sheets(Sheets.Count)
 
    With sh
        .Name = "exemple"
          For col = 0 To UBound(mescol)
            For i = 2 To sh.Cells(Rows.Count, mescol(col)).End(xlUp).Row
                dico(sh.Cells(i, mescol(col)).Text) = dico(sh.Cells(i, mescol(col)).Text) & Cells(i, mescol(col)).Address & " "
            Next
        Next
    End With
For Each elem In dico
Debug.Print elem & "  " & Range(Replace(Application.Trim(dico(elem)), " ", ",")).Address
Next
End Sub

08/04/2018, 10h48
chocho1990

merci pour ta reponse mais mon probleme est de fusionner les collones que je choisie alors rien n'est resolu pour le moment
08/04/2018, 16h25
patricktoulon

re

Citation:

merci pour ta reponse mais mon probleme est de fusionner les collones que je choisie alors rien n'est resolu pour le moment

non!! dans ton exmple avec resultat tu fusionne pas les colonnes mais les lignes !!
08/04/2018, 16h39
Marc-L

Bonjour !

chocho1990,
sachant qu'une fois fusionné c'est chaud pour exploiter les données (en fait souvent inexploitable !)
quelle serait l'utilité de cette feuille après "fusion" ?

S'il y a besoin d'exploiter les données ensuite, alors la fusion est une erreur car
il suffit juste d'afficher ou pas les données et de les conserver tel quel dans la table source …

___________________________________________________________________________________________________________
Je suis Paris, Egypte, Nigeria, New-York, Mogadicio, Barcelone, London, Manchester, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …