Discussion :

[sawsliders]

Bonjour,(rebonjour pour ceux qui m'ont déjà beaucoup aidé en ce jours.

Alors j'aurais encore une question

J'ai dans une feuille avec X ligne (nombre variable)

dans cette feuille j'ai des valeur dans la colonne B qui ce répété.

Je voudrais crée une fusion si dans Cellule B4 et B5 sont identique alors les fusionnée

Parfois il peux i avoir plusieurs répétition de valeur (s'il y en a 10 il faux fusionné les 10, si 100 fusionnée les 100 ...) dans tout les cas elle sont adjacente entre-elles

Auriez-vous un bout de script pour du VBA qui pourrait m'aider à trouvé une solution.

Par la suite j'aurais une autre question avec ce bout de scripte :p mais déjà cette partie la sera débloquant pour moi.

Par avance merci beaucoup pour votre travaille parfait surtout bénévole.

Filipe D

[Thautheme]

Bonsoir Felipe, bonsoir le forum,

Attention ! Les cellules fusionnées sont ennemies jurées de VBA. Si tu dois coder par la suite avec des cellules fusionnées c'est bien plus galère qu'avec des cellules qui se répètent. Je ne te le conseille pas..

Le code pour le faire :

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
Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim SD As Variant 'déclare la variable SD (Sans Doublon)
Dim NO As Variant 'déclare la variable NO (Nombre d'Occurrences)
 
Set O = Sheets("Feuil1") 'définit l'onglet O (à adapter)
DL = O.Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 2 (=B) de l'onglet O
Set PL = O.Range("B1:B" & DL) 'définit la plage PL
TC = PL 'définit le tableau de cellules TC
Set D = CreateObject("SCripting.Dictionary") 'définit le dictionnaire D
For I = 1 To UBound(TC, 1) 'boucle sur toutes les lignes I du tableau de cellues TC
    D(TC(I, 1)) = D(TC(I, 1)) + 1 'alimente le dictionnaire D
Next I 'prochaine ligne de la boucle
SD = D.keys 'récupère la liste sans doublon dans le tableau SD
NO = D.items 'récupère le nombre d'occurence de chaque élément de SD dans le tableau NO
Application.DisplayAlerts = False 'empêche les messages d'Excel (la fusion de plusieurs cellues éditées déclenche un message)
For I = 0 To UBound(NO, 1) 'boucle sur tous les éléments du tableau NO
    If NO(I) > 1 Then 'condition : si le nombre d'occurrences de l'élément de la boucle est supérieur à 1
        Set R = O.Columns(2).Find(SD(I), O.Cells(DL, 2), xlValues, xlWhole) 'recherche l'élément entier dans la colonne 2 (=B) de l'onglet O
        R.Resize(NO(I), 1).Merge 'redimensionne l'élément trouvé et le fusionne
    End If 'fin de la condition
Next I 'prochain élément du tableau NO
Application.DisplayAlerts = True 'affiche les messages d'Excel
End Sub

[sawsliders]

Attention ! Les cellules fusionnées sont ennemies jurées de VBA. Si tu dois coder par la suite avec des cellules fusionnées c'est bien plus galère qu'avec des cellules qui se répètent. Je ne te le conseille pas..

Tout d'abord grand merci encore une fois je vois qu'en plus d’être hyper actif sur le forum tu as une tres grand largeur de connaissance.

Alors j'ai du modifié un peux le code :

Changé la variable I en A puisque je dispose déjà dans mon code sources (les autre bout avant celui la) une variable I.

Es-que j'ai fait une erreur ?

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
Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim A As Integer 'déclare la variable I (Incrément)
Dim SD As Variant 'déclare la variable SD (Sans Doublon)
Dim NO As Variant 'déclare la variable NO (Nombre d'Occurrences)
 
Set O = Sheets("Feuil1") 'définit l'onglet O (à adapter)
DL = O.Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 2 (=B) de l'onglet O
Set PL = O.Range("B1:B" & DL) 'définit la plage PL
TC = PL 'définit le tableau de cellules TC
Set D = CreateObject("SCripting.Dictionary") 'définit le dictionnaire D
For A = 1 To UBound(TC, 1) 'boucle sur toutes les lignes I du tableau de cellues TC
    D(TC(A, 1)) = D(TC(A, 1)) + 1 'alimente le dictionnaire D
Next A 'prochaine ligne de la boucle
SD = D.keys 'récupère la liste sans doublon dans le tableau SD
NO = D.items 'récupère le nombre d'occurence de chaque élément de SD dans le tableau NO
Application.DisplayAlerts = False 'empêche les messages d'Excel (la fusion de plusieurs cellues éditées déclenche un message)
For A = 0 To UBound(NO, 1) 'boucle sur tous les éléments du tableau NO
    If NO(A) > 1 Then 'condition : si le nombre d'occurrences de l'élément de la boucle est supérieur à 1
        Set R = O.Columns(2).Find(SD(I), O.Cells(DL, 2), xlValues, xlWhole) 'recherche l'élément entier dans la colonne 2 (=B) de l'onglet O
        R.Resize(NO(A), 1).Merge 'redimensionne l'élément trouvé et le fusionne
    End If 'fin de la condition
Next A 'prochain élément du tableau NO
Application.DisplayAlerts = True 'affiche les messages d'Excel
End Sub

J'ai bloque à la ligne (à la fin), es-du à mon changement de I en A ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

            R.Resize(NO(A), 1).Merge 'redimensionne l'élément trouvé et le fusionne

Merci encore du coup de main .

[Thautheme]

Re,

Tu as oublié de modifier dans cette ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set R = O.Columns(2).Find(SD(I), O.Cells(DL, 2), xlValues, xlWhole) 'recherche l'élément entier dans la colonne 2 (=B) de l'onglet O

qui devient :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set R = O.Columns(2).Find(SD(A), O.Cells(DL, 2), xlValues,  xlWhole) 'recherche l'élément entier dans la colonne 2 (=B) de l'onglet O

[sawsliders]

Bonjour,

Exacte j'ai oublié cette ligne la.

Par contre cela ne résout pas mon probleme :s. il plante toujours au même endroit

[Thautheme]

Re,

Aucun planton chez moi ! Voir pièce jointe...