XL 2016 Fusionner les doublons de date

scrib · 8 Mars 2021

Bonjour,
Je voudrais fusionner les cases qui ont la même date, mais le code que j'ai fais ne fonctionne pas, pouvez-vous m'aider?
L'erreur que je reçois est :
Ligne => "Un.Add.Cell , CDate(Cell)"
instruction => "CDate(Cell)"
Erreur retournée => erreur compilation: argument non facultatif

VB:

Dim Plage As Range
    Dim Cell As Range
    Dim Un As New Collection
    Dim Tableau() As Integer
    Dim Nombre As Integer
     Set Plage = Sheets("feuil2").Crange("A2:A1048521")
    On Error Resume Next
    For Each Cell In Plage
        Un.Add.Cell , CDate(Cell)
        If Err.Number <> 0 Then
            Nombre = Nombre + 1
            ReDim Preserve Tableau(1 To Nombre)
            Tableau(Nombre) = Cell.Row
            Err.Clear
        End If
    Next Cell
    On Error GoTo 0
    If Nombre = 0 Then
        Exit Sub
    End If
    For nomnbre = UBound(Tableau) To LBound(Tableau) Step -1
        Sheets("Feuil2").Cells(Tableau(Nombre)).Merge
    Next Nombre

Merci pour vos futures réponses

pierrejean · 8 Mars 2021

Bonjour scrib

Je te suggère cette macro

VB:

Sub fusion()
For n = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
   If IsDate(Range("A" & n)) And Range("A" & n - 1) = Range("A" & n) Then
    Application.DisplayAlerts = False
      Range("A" & n & ":A" & n - 1).MergeCells = True
    Application.DisplayAlerts = True
   End If
Next
End Sub

Excel_addin · 8 Mars 2021

Bonjour scrib, le forum
Peux-tu nous fournir un fichier exemple stp ?
En attendant,
il y a quelques fautes de frappe dans ton code :

Ligne 6 (remplace Crange par range)

Code:

Set Plage = Sheets("feuil2").Crange("A2:A1048521")

Ligne 9 (remplace Un.Add.Cell par Un.Add Cell

Code:

Un.Add.Cell , CDate(Cell)

Ligne 21 (remplace nomnbre par nombre)

Code:

For nomnbre = UBound(Tableau) To LBound(Tableau) Step -1

Cordialement.

pierrejean · 8 Mars 2021

Bonjour scrib

Je te suggère cette macro

VB:

Sub fusion()
For n = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
   If IsDate(Range("A" & n)) And Range("A" & n - 1) = Range("A" & n) Then
    Application.DisplayAlerts = False
      Range("A" & n & ":A" & n - 1).MergeCells = True
    Application.DisplayAlerts = True
   End If
Next
End Sub

scrib · 8 Mars 2021

Bonjour pierrejean et Excel_addin,
Merci pour vos réponses, je mets le fichier est en pièce jointe. J’essaierai vos solutions demain matin et je reviens vers vous.
Cordialement.

scrib · 9 Mars 2021

pierrejean à dit:

Bonjour scrib

Je te suggère cette macro

VB:

Sub fusion()
For n = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
   If IsDate(Range("A" & n)) And Range("A" & n - 1) = Range("A" & n) Then
    Application.DisplayAlerts = False
      Range("A" & n & ":A" & n - 1).MergeCells = True
    Application.DisplayAlerts = True
   End If
Next
End Sub

Merci pour cette solution.

scrib · 9 Mars 2021

Bonjour pierrejean,

La solution fonctionne, mais si l'on ouvre plusieurs fois sur le fichier ça ne fonctionne pas.
Ca ne reprend pas les cases fusionnées de la session d'avant. Je joints le fichier pour essai.
Merci
Cdtl.

scrib · 9 Mars 2021

Je viens de trouver la réponse à ma dernière question.
Merci à vous deux.

XL 2016 Fusionner les doublons de date

scrib

XLDnaute Nouveau

pierrejean

Excel_addin

XLDnaute Nouveau

pierrejean

XLDnaute Barbatruc

scrib

XLDnaute Nouveau

Pièces jointes

scrib

XLDnaute Nouveau

scrib

XLDnaute Nouveau

Pièces jointes

scrib

XLDnaute Nouveau

Discussions similaires

XL 2016 Fusionner les doublons de date

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency