Réalisation d'un macro pour fusionner des cellules sous conditions

**yannickcochard** · 08/05/2015, 00h51

Bonjour

Je suis nouveau sur ce forum et j'aimerais avoir votre aide.

J'utilise excel pour ma planification

Voila je veux créer une macro qui me fusionnera 2 cellules en fonction de ce qu'il y a dans une cellule.

dans la sélection G15:T184 je voudrais que lorsque que "R" apparaît, cette même cellule se fusionne avec la cellule juste à sa droite.

CF : modèle de fusion en G15 et I15 sur pièce jointe

Egalement je voudrais le faire avec "cp" "cif" etc...

Voici une image de mon fichier
exemple fusion de cellule.docx

Par avance merci de votre retour

**joe.levrai** · 08/05/2015, 01h55

Bonjour,

voici une proposition

ce n'est pas la plus optimisée, mais tu peux la customiser très facilement, tout est commenté

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
Sub Fusion()
Dim Tablo
Dim TabMotif()
Dim i As Integer
Dim j As Integer
Dim k As Integer
 
' ici le tableau avec les motifs modifiables
TabMotif = Array("R", "CP", "CIF", "RTT")
 
' adapter le nom de la feuille
With Worksheets("Feuil3")
    ' chargement de la plage dans un tableau
    Tablo = .Range("G15:T184")
    ' boucle à l'envers sur les lignes
    For i = UBound(Tablo, 1) To LBound(Tablo, 1) Step -1
        ' boucle à l'envers sur les colonnes
        For j = UBound(Tablo, 2) To LBound(Tablo, 2) Step -1
            ' boucle sur les motifs
            For k = LBound(TabMotif) To UBound(TabMotif)
                ' si la cellule contient le motif
                ' et qu'elle n'est pas fusionnées
                ' et que sa voisine de droite non plus
                If Tablo(i, j) = TabMotif(k) _
                And .Cells(i + 14, j + 5).Address = .Cells(i + 14, j + 5).MergeArea.Address _
                And .Cells(i + 14, j + 6).Address = .Cells(i + 14, j + 6).MergeArea.Address Then
                    Application.DisplayAlerts = False
                    ' on les fusionne
                    .Range(.Cells(i + 14, j + 5), .Cells(i + 14, j + 6)).Merge
                    Application.DisplayAlerts = True
                End If
            Next k
        Next j
    Next i
End With
 
End Sub

**yannickcochard** · 09/05/2015, 02h15

Bonjour

Et merci beaucoup pour votre aide.

J'ai essayé votre macro

mais un message d'erreur s'affiche (cf pièce jointe).
problème 13.pdf problème 13.pdf problème 13.pdf

Par avance merci de votre aide.

Cdt
Yannick

**joe.levrai** · 09/05/2015, 08h04

Bonjour,

je n'arrive pas à reproduire le problème, peux-tu joindre un fichier tout simple, avec une copie de la feuille où cela ne fonctionne pas ?

remplacer les prénoms d'employés par des noms communes (pomme, poire etc..) pour que ça soit confidentiel si besoin

**yannickcochard** · 15/05/2015, 22h29

Bonjour

Désolé pour le retard , mais le boulot me prend pas mal de temps et merci beaucoup pour votre aide.

Je met en pièce jointe le fichier excel.

Egalement si vous avez une solution pour que dans les cases du tableau suivant (G185 : T198)

je mette une formule du genre: =NB.SI (G45:G67; horaire inscrit) ===> je veux la somme des cases avec des horaires indiqués dedans.

Par avance merci pour aide.

Yannickplanning à la semaine sans nom.xlsm

**joe.levrai** · 16/05/2015, 00h28

Bonjour,

l'erreur provient du fait que tu as des formules RECHERCHEV sur chaque cellule de la plage
or, tu utilises certaines lignes pour couper ton tableau, et les formules qui renvoient "#N/A" sont noircies pour faire des séparations
j'ai ajouté un test supplémentaire qui les exclus des tests de comparaison
il y avait également une petite erreur de ciblage que j'ai rectifié au passage, elle excluait certains cas positifs

j'ai testé sur ton fichier tel qu'envoyé, et ça m'a l'air conforme

concernant l'addition des plages horaires remplies, il y a surement une méthode par fonction excel (qu'il faut toujours privilégier), mais je ne suis pas assez doué à cet exercice, de part les contraintes (cellules fusionnées et structure du tableau)

je passe la main sur ce sujet, si on pouvait éviter par VBA

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
Sub Fusion()
Dim Tablo
Dim TabMotif()
Dim i As Integer
Dim j As Integer
Dim k As Integer
 
' ici le tableau avec les motifs modifiables
TabMotif = Array("R", "CP", "CIF", "RTT")
 
' adapter le nom de la feuille
With Worksheets("Planning")
    ' chargement de la plage dans un tableau
    Tablo = .Range("G15:T184")
    ' boucle à l'envers sur les lignes
    For i = UBound(Tablo, 1) To LBound(Tablo, 1) Step -1
        ' boucle à l'envers sur les colonnes
        For j = UBound(Tablo, 2) To LBound(Tablo, 2) Step -1
            ' boucle sur les motifs
            For k = LBound(TabMotif) To UBound(TabMotif)
 
                ' si la cellule ne contient pas d'erreur sur une formule
                If Not IsError(Tablo(i, j)) Then
 
                    ' si la cellule contient le motif
                    ' et qu'elle n'est pas fusionnées
                    ' et que sa voisine de droite non plus
                    If Tablo(i, j) = TabMotif(k) _
                    And .Cells(i + 14, j + 6).Address = .Cells(i + 14, j + 6).MergeArea.Address _
                    And .Cells(i + 14, j + 7).Address = .Cells(i + 14, j + 7).MergeArea.Address Then
                        Application.DisplayAlerts = False
                        ' on les fusionne
                        .Range(.Cells(i + 14, j + 6), .Cells(i + 14, j + 7)).Merge
                        Application.DisplayAlerts = True
                    End If
                End If
            Next k
        Next j
    Next i
End With
 
End Sub

**yannickcochard** · 17/05/2015, 17h16

Bonjour

C'est génial merci beaucoup

Pour la formule NB.SI sous condition j'ai trouvé.

Par contre as tu la solution pour que dans une macro j'indique qu'il faut ouvrir un fichier excel spécifique dont le nom de ce fichier est dans une case du fichier excel ou j'applique cette macro.

Exemple: dans le fichier que je t'ai envoyé , je marque dans la cellule w2 : semaine22
je veux que dans une macro il aille m'ouvrir un fichier excel du nom "semaine22" (donc = W2) dans un dossier que je désignerais moi même.
Ce fichier excel semaine22 sera créer par des collaborateurs chaque semaine.....

Workbooks.Open Filename:="F:\temp\semaine21.xlsx"
Selection.Copy
Windows("planning à la semaine type.xlsm").Activate
Sheets("Plan").Select
Cells.Select
ActiveSheet.Paste
Windows("semaine21.xlsx").Activate

Voici ma macro actuelle, je voudrais que le semaine21 soit remplacé par ce qu'il y a dans la cellule W2.

Par avance merci de ton aide

**joe.levrai** · 17/05/2015, 18h28

Il suffit de prendre la valeur en W2 pour faire l'ouverture du fichier

Code :

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

1
2
3
4
Dim NomFichier As String
 
NomFichier = Worksheets("Planning").Range("W2").Value
Workbooks.Open Filename:="F:\temp\" & NomFichier & ".xlsx"

attention, si le fichier n'existe pas, il y aura erreur
si tu n'es pas sûr que le fichier existe quand tu lances la procédure, tu dois prévoir le cas

**yannickcochard** · 18/05/2015, 21h49

Encore merci pour ton aide

Workbooks.Open Filename:="F:\temp\semaine21.xlsx"
Selection.Copy
Windows("planning à la semaine type.xlsm").Activate
Sheets("Plan").Select
Cells.Select
ActiveSheet.Paste
Windows("semaine21.xlsx").Activate

Il me manque encore une chose:

Windows ("planning à la semaine type.xlsm")Activate

Je voudrais que cette ligne sélectionne automatiquement le nom du fichier dans lequel la macro est exécuté.

Car le nom du fichier va changer ==> je doit garder une copy de chaque planning à la semaine.
Donc je pars de la matrice , et je vais travaillé en enregistrant une copy sous un nom différent à chaque fois ( ex: planningsemaine21").

**joe.levrai** · 19/05/2015, 01h31

tu remplaces le dernier code que j'ai proposé, par

Code :

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

1
2
3
4
Dim NomFichier As String
 
NomFichier = Worksheets("Planning").Range("W2").Value & ".xlsx"
Workbooks.Open Filename:="F:\temp\" & NomFichier

et tu peux faire référence au classeur ainsi :

Code :

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

Windows (NomFichier).Activate

Réalisation d'un macro pour fusionner des cellules sous conditions

Excel

Discussions similaires

Partager

Partager