Fustion automatique

Bonjour,

Voila mon souci, je suis actuellement occupé avec le calendrier de mon club et je par moment mes équipes jouent a la même date, ce que je voudrai, si c'est possible, et que les dates qui se suivent, fusionne pour en faire qu'un automatiquement.

Exemple.

08/09/2017 reste seul

09/09/2017

09/09/2017 (les 2 dates doivent en former que 1 seul ?)

Fichier en pièce jointe pour plus de détail.

https://www.cjoint.com/c/GHlpvd7Rufo

Merci de votre aide


a oui petite précision faudrai que ça le fasse aussi pour les adresse des salles.

Merci

Bonjour,

je le ferais plutôt avec une MFC

https://www.cjoint.com/c/GHlqxMKUzXw

oui merci j'avais déjà trouver avec une MFC mais ça ne fait fusionne pas mes cellules malheureusement

Bonjour

La fusion apporte plein d'emm... : il est toujours préférable de s'en passer.

Une ou des MFC appropriées sont préférables...

J'ai trouver ceci sur internet mais ça fonctionne que sur la Colonne A pas sur la colonne G, hors je voudrai que ça se fasse dans les 2 colonnes

"""""""""""""""""""""""""

Sub test()

Dim val As String, valad As String

Range("C2").Select

Do Until ActiveCell.Value = ""

val = ActiveCell.Value

valad = ActiveCell.Address

flag = True

Do While val = ActiveCell.Value

ActiveCell.Offset(1, 0).Select

If flag = False Then

ActiveCell.Offset(-1, 0).ClearContents

End If

flag = False

Loop

ActiveCell.Offset(-1, 0).Select

Range(valad, ActiveCell.Address).Select

With Selection

.Merge

.MergeCells = True

.VerticalAlignment = xlTop

End With

ActiveCell.Offset(1, 0).Select

Loop

End Sub

"""""""""""""""""""""""""

Merci

Bonjour,

têtu le gaillard !!!

P.

oui très têtu même...


Faudrai juste que je sache comment écrire le même code avec A6 et G6 après le Range, mais je sais pas comment on fait

Sub test()

Dim val As String, valad As String

Range("A6").Select

Do Until ActiveCell.Value = ""

val = ActiveCell.Value

valad = ActiveCell.Address

flag = True

Do While val = ActiveCell.Value

ActiveCell.Offset(1, 0).Select

If flag = False Then

ActiveCell.Offset(-1, 0).ClearContents

End If

flag = False

Loop

ActiveCell.Offset(-1, 0).Select

Range(valad, ActiveCell.Address).Select

With Selection

.Merge

.MergeCells = True

.VerticalAlignment = xlTop

End With

ActiveCell.Offset(1, 0).Select

Loop

End Sub

re,

puisque tu y tiens

Option Explicit ' obligation de déclarer les variables

Sub Fusion()
Dim Last&, i&
Application.DisplayAlerts = False
Last = [A65000].End(xlUp).Row
   If Cells(i, 1) = Cells(i - 1, 1) Then
      Range(Cells(i, 1), Cells(i - 1, 1)).Merge
   End If
Next i
End Sub

je suis tres chiant aussi mais peux-tu m'eclairer de ou je dois mettre ca, si c'est au debut de mon macro ou a la fin et par rapport au sub et ,End sub lol. merci

loic.vazquez a écrit :

je suis tres chiant aussi mais peux-tu m'eclairer de ou je dois mettre ca, si c'est au debut de mon macro ou a la fin et par rapport au sub et ,End sub lol. merci

HA bon....

ALT-F11/insertion/module et tu y copies ce code

Je ne connais pas ta macro, celle-ci fait la fusion que tu demandais

P.

cool merci pour ton aide je test ca au plus vite


Ah ben désoler de t'ennuyer encore mais ça ne fonctionne pas, je fais un copier coller de ton code que tu m'as donner, seul sans ce que j'avais déjà et il met "erreur de compilation. Next sans For"

Les emmerdes ça commence ! alors qu'une MFC c'est simple et il ne faut pas défusionner .... moi aussi je suis têtu !

je sais mais je veux aussi essayer de comprendre le code excel quand j'en ai besoin...

loic.vazquez a écrit :

cool merci pour ton aide je test ca au plus vite


Ah ben désoler de t'ennuyer encore mais ça ne fonctionne pas, je fais un copier coller de ton code que tu m'as donner, seul sans ce que j'avais déjà et il met "erreur de compilation. Next sans For"

Tu as 10 lignes à copier (mon code) je ne vois pas comment tu fais ...

Si tu l'insères dans un autre code, il faut y regarder à 2 fois !

Fini pour ce jour ..

P.

moi je veux bien mais j'ai fais exacetement ce que tu as dit : alt+F11/insertion/module, la j'ai une fenetre qui c'est ouvert, j'ai copier coller ton code, enregistrer, et lorsque je vais dans Macro et que je veux executer celui ci, il m'indique d'abord "erreur de compilation. Next sans For" et par moment j'ai un autre message qui dit "Impossible d'exécuter du Code en Mode arrêt".

Donc je sais pas ce que je peux faire... du coup

Bonsoir loic.vazquez

Pour en revenir à la demande initiale

Dans ce cas là, comment procèdes tu ?

Tu fusionnes les 4 cellules contenant la même date en colonne A, puis en colonne G, tu fais quoi ?

match

Il faut clarifier les choses en nous présentant tous les cas pouvant se présenter.

klin89

Bonjour,

le problème que je rencontre est le suivant :

Pour la colonne A, il faudrait que des que 2 ou + de même dates se suivent, sa se fusionne automatique et centrer sur la droite.

Pour la colonne G, il faudrait que des que 2 et seulement 2 même adresse de salles se suivent, que ça se fusionne et centrer a gauche.

Merci

Re loic.vazquez,

Restitution en Feuil1 préalablement créée

La feuille source reste en l'état initial ---> pas de cellule fusionnée

A tester :

Option Explicit
Sub test()
Dim a, w(), i As Long, j As Long, n As Long, lig As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    With Sheets("Calendrier")
        a = .Range("a5").CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            If Not dico.exists(a(i, 1)) Then
                Set dico(a(i, 1)) = CreateObject("Scripting.Dictionary")
                dico(a(i, 1)).CompareMode = 1
            End If
            If Not dico(a(i, 1)).exists(a(i, 7)) Then
                ReDim w(1 To UBound(a, 2), 1 To 1)
            Else
                w = dico(a(i, 1))(a(i, 7))
                ReDim Preserve w(1 To UBound(w, 1), 1 To UBound(w, 2) + 1)
            End If
            For j = 1 To UBound(w, 1)
                w(j, UBound(w, 2)) = a(i, j)
            Next
            dico(a(i, 1))(a(i, 7)) = w
        Next
    End With
    Application.ScreenUpdating = False
    With Sheets("feuil1").Range("a1")
        .CurrentRegion.Cells.Clear: n = 1
        .Resize(1, UBound(a, 2)).Value = a
        Application.DisplayAlerts = False
        For i = 0 To dico.Count - 1
            lig = n
            For j = 0 To dico.items()(i).Count - 1
                With .Offset(n).Resize(UBound(dico.items()(i).items()(j), 2), _
                                       UBound(dico.items()(i).items()(j), 1))
                    .FormulaLocal = Application.Transpose(dico.items()(i).items()(j))
                    If UBound(dico.items()(i).items()(j), 2) > 1 Then
                        .Columns(7).Merge
                    End If
                End With
                n = n + UBound(dico.items()(i).items()(j), 2)
            Next
            If n - lig > 1 Then
                With .Offset(lig).Resize(n - lig)
                    .Merge
                    .Resize(, 7).BorderAround Weight:=xlThin
                End With
            End If
            '            If n > lig + 1 Then
            '                .Range(.Cells(lig + 1, 1), .Cells(n, 1)).Merge
            '            End If
        Next
        Application.DisplayAlerts = True
        With .CurrentRegion
            .Columns("b:d").NumberFormat = "hh \h mm"
            With .Font
                .Name = "calibri": .Size = 10
            End With
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .VerticalAlignment = xlCenter
            With .Rows(1)
                .HorizontalAlignment = xlCenter
                .BorderAround Weight:=xlThin
                .Interior.ColorIndex = 36
                .Font.Size = 10
            End With
            .Columns.AutoFit
        End With
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Bonjour,

Ne connaissant pas encore grand chose, je place le code que tu m'as donner dans un module ?? on est d'accord. ensuite je dois sauvegarder comme si je sauvegardais un fichier, appuyer sur oui.

Sur la feuille de calendrier, aller dans macro et executer ?

En tout cas merci de m'aider

lorsque je l'utilise il me met une erreur 9 a la ligne suivante : With Sheets("feuil1").Range("a1")

En feuil1, je dois écrire le nom de ma feuille et en A1 la cellule de début ? sachant que ça doit etre que sur les colonnes A et G ??


Super ça a fonctionner la seul chose est que toute le travail de couleur et mise en page qui est parti du coup je me retrouve avec ça https://www.cjoint.com/c/GHmtKaGIwZo

Rechercher des sujets similaires à "fustion automatique"