Insertion de ligne et fusion de certaines de ces cellules

Fred_83

XLDnaute Nouveau
Bonsoir,

Ça y est je me remets peu à peu sur mes acquis mais dur … c’est pas comme le vélo en plus je n'ai plus moyen de me connecter sous mon ancien compte car j'ai perdu mon mdp et ma boite mail (@club-internet) est inaccessible!
Bon les bases c'est un peu ça mais pour les assembler j'ai du mal et vu l'heure tardive j'abandonne pour ce soir...

Du coup je suis dans l’impasse et je n’arrive pas à finaliser mon fichier avec des retours d’erreurs ou d’incompréhension totale (de ma part). Je recommence sans cesse avec plus ou moins toutes les infos que je possède mais sans réussite pour l'instant.

J’ai un tableau excel dans lequel je saisi des données par ligne de A à J avec la possibilité de saisir plus d’une date dans la colonne J et plus d’un nom dans la colonne M. Dans ce cas il faut qu’une ligne soit insérée pour chacune de ces données mais avec fusion de chacune des cellules de cette ligne avec chaque cellule respective du dessus.

Je souhaiterais par contre pouvoir par la suite pouvoir modifier des données en M et

- soit je valide par une date en L et dans ce cas là ma ligne fusionnée est finalisée et je souhaite alors la colorer en vert (par exemple),

- soit je saisi une date en K et dans ce cas là j’aimerais avoir la possibilité d’avoir le choix d’insérer 1, 2 ou 3 lignes vides juste en dessous par boite de validation par exemple. Le problème est que je souhaite alors que chacune des cellules de cette ligne insérée soit elles aussi pour chacune fusionnée avec celle du dessus.

Je suis obligé de garder ce système de saisie car il y a derrière beaucoup de calculs divers.

Je suis arrivé à insérer mes lignes par Commandbutton mais j’obtiens un pb avec la fusion des cellules vides de certaines colonnes.

Pour information les données ne sont pas forcément saisies dans toutes les cases (de B à I).
Comme un fichier vaut mieux qu'un grand discours j'ai essayé d'exposer le pb!
Merci par avance pour votre aide.
Fred
 

Pièces jointes

  • TabStat.xlsx
    13.9 KB · Affichages: 40

Fred_83

XLDnaute Nouveau
Bonjour Lone-wolf et déjà merci pour cette réponse très rapide.
Je suis déjà surpris d'avoir pu exprimer mon besoin et pour répondre à ta question, le fichier en question n'est qu'une partie d'un document dans lequel énormément de statistiques sont émises et elles dépendent pratiquement toutes des données des cellules des colonnes A, B ou C et j'anticipe en plus toutes autres possibilités qui me seront par la suite (surement) demandées.
En plus, c'est aussi dans un soucis de lisibilité et je dois avoir une vingtaine de fichiers comme celui ci dont la base devra être la même.
Je remets le fichier dans la version demandée mais il n'y a pas de macro sur ce fichier que j'ai simplifié.
Bonne journée à tous,
 

Pièces jointes

  • TabStat.xls
    25.5 KB · Affichages: 34
  • TabStat.xlsm
    13.1 KB · Affichages: 35
Dernière édition:

chris

XLDnaute Barbatruc
Bonjour

La fusion de cellules amène toujours un certain nombre de problèmes : outre la nécessité ici de défusionner, refusionner, à chaque nouvelle saisie, ce type de structure sera difficilement exploitable pour les statistiques sans repasser par VBA.
De plus ce n'est quasiment ni triable, ni filtrable...

Pour les stats il existe des outils très performants comme les TCD mais qui ne peuvent utiliser des données fusionnées.

Il serait plus viable à mon avis de créer une structure de type tableau avec la répétition des données des colonnes A à I mais avec une mise en forme conditionnelle qui donne un aperçu visuel proche de celui de ta fusion.
Ainsi les données restent triables, filtrables, et conforme à la notion de liste de données exploitable par TCD.
 

Pièces jointes

  • TabStat.xlsx
    17.1 KB · Affichages: 41

Fred_83

XLDnaute Nouveau
Bonjour Chris,
J'avais en effet pensé à la mise en forme conditionnelle mais (il y a toujours un "mais") au boulot, nous arrivons tout juste à faire comprendre que nous avons besoin d'excel impérativement (travail collaboratif avec l'extérieur) que nous n'avons que la version 2003 donc que 3 possibilités de condition et celles ci sont déjà exploitées.
Pour l'instant j'avais avancé un petit peu et je vais essayer de retranscrire ce que j'avais fait sur ce tableau (les données originales sont confidentielles et je ne peux malheureusement pas les poster, c'est pour ça que les informations dans le fichier transmis peuvent faire sourire). Avec mes premières ébauches les statistiques semblaient être conformes aux différentes données mais j'avançais petit à petit.
 

Fred_83

XLDnaute Nouveau
Bon j'arrive peu à peu à mes fins et non sans mal...
Par contre je butte ce coup ci sur la colorisation afin que toute la ligne (avec les fusions) soit colorée...
Je mets à cet effet le nouveau fichier au cas où.
J'ai pris bonne note aussi de toutes vos informations concernant la fusion et les problèmes que celà engendre mais comme précisé plus haut je suis contraint de faire ça pour la visibilité et la volonté de travail de mes collègues... ce qui fera d'ailleurs l'objet de ma prochaine étape de travail : la déprotection et la reprotection du fichier ;)
Merci
 

Pièces jointes

  • Stats_NM2_Ins_NC_Fusion.xls
    69.5 KB · Affichages: 45

job75

XLDnaute Barbatruc
Bonsoir Fred_83, Lone-wolf, chris,

Voyez la macro Worksheet_Change dans le code de la feuille en PJ.

La couleur (verte) est appliquée par une MFC qui utilise cette petite fonction VBA :
Code:
Function MFC(c As Range)
With Cells(c.Row, 1).MergeArea
  MFC = Application.CountA(.Offset(, 11).Resize(.Count))
End With
End Function
Et bonne nuit.
 

Pièces jointes

  • TabStat(1).xls
    91 KB · Affichages: 44

job75

XLDnaute Barbatruc
Re,

Si l'on fait un copier-coller entre des cellules du tableau c'est le pataquès.

La CurrentRegion se réduit alors à la 1ère ligne, je n'avais jamais vu ça.

Je n'ai pas trouvé d'autre solution dans ce cas que de neutraliser la macro :
Code:
If Application.CutCopyMode Then Exit Sub 'en cas de copier-coller
Prenez ce fichier (2).

Re-bonne nuit.
 

Pièces jointes

  • TabStat(2).xls
    91.5 KB · Affichages: 47

job75

XLDnaute Barbatruc
Bonjour Fred_83, le fil, le forum,

Il n'y avait pas que le couper-coller qui posait problème.

Avec les fichiers précédents insérez des lignes ou des cellules n'importe où...

En fait ces problèmes viennent de la MFC, dans ce fichier (3) je ne l'utilise donc plus :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, i&, n, j As Byte
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If Intersect(Target, [A5].CurrentRegion) Is Nothing Then GoTo 1
'---contrôle des dates---
Set r = Intersect(Target, [A5].CurrentRegion.Offset(1), [J:L])
If r Is Nothing Then GoTo 1
For Each r In r 'si entrées/effacements multiples
  If r <> "" And Not IsDate(r) Then r = "": r.Select
Next
'---insertion de lignes---
If Target.Row > 5 And Target.Column = 11 And Target.Count = 1 Then
  Set r = Cells(Target.Row, 1).MergeArea
  i = r.Count
  If Application.CountA(r.Offset(, 10).Resize(i)) = i Then
    Application.ScreenUpdating = True
    n = 1
    Do
      n = Abs(Int(Val(InputBox("Entrer 1 2 ou 3 pour insérer des lignes :", "Insertion", n))))
    Loop While n > 3
    Application.ScreenUpdating = False
    If n = 0 Then GoTo 1
    Target(2).EntireRow.Resize(n).Insert
    For j = 0 To 8
      r.Offset(, j).Resize(i + n).Merge
    Next
  End If
End If
'---mise en couleur (verte)---
Set r = Intersect(Target, [A5].CurrentRegion.Offset(1), [L:L])
If r Is Nothing Then GoTo 1
For Each r In r 'si entrées/effacements multiples
  Set r = Cells(r.Row, 1).MergeArea
  i = r.Count
  r.Resize(i, 14).Interior.ColorIndex = IIf(Application.CountA(r.Offset(, 11).Resize(i)), 35, xlNone)
Next
1 Application.EnableEvents = True 'réactive les évènements
Set r = Range("A6:N" & Rows.Count)
'---suppression des bordures---
r.Borders.LineStyle = xlNone
'---défusion des cellules sous le tableau si effacements---
i = [A5].CurrentRegion.Row + [A5].CurrentRegion.Rows.Count
Range("A" & i & ":N" & Rows.Count).UnMerge
'---création de nouvelles bordures---
Set r = Intersect(r, [A5].CurrentRegion)
If Not r Is Nothing Then r.Borders.Weight = xlThin
End Sub
A+
 

Pièces jointes

  • TabStat(3).xls
    88.5 KB · Affichages: 47
Dernière édition:

Fred_83

XLDnaute Nouveau
Bonsoir Job75, Lone-wolf, Chris et tous,
Merci pour ce taf là encore impressionnant!
Je suis en train de voir et d'étudier un peu le fichier (j'aime bien comprendre ^^) qui m'avance énormément, et je vais essayer de le transposer dans le fichier original (et là il faut absolument que j'ai compris).... quelques colonnes à modifier ou à inverser... je potasse ça et je vous tiens au courant..
 

job75

XLDnaute Barbatruc
Bonjour Fred_83, le forum,

Une version avec un numéro d'ordre en colonne A et une MFC 2 couleurs (qui va bien) :
Code:
Const deb$ = "A5" 'adresse de la 1ère cellule du tableau, à adapter
Const nfusion% = 10 'nombre de cellules fusionnées par ligne, à adapter
Const col1% = 11 'colonne de Date 1, à adapter
Const col2% = 12 'colonne de Date 2, à adapter
Const col3% = 13 'colonne de Date 3, à adapter

Private Sub Worksheet_Change(ByVal Target As Range)
Dim coldeb%, P As Range, r As Range, i&, n, j%
coldeb = Range(deb).Column
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Set P = Range(deb).CurrentRegion
If Intersect(Target, P) Is Nothing Then GoTo 1
'---contrôle des dates---
Set r = Intersect(Target, P.Offset(1), Union(P.Columns(col1), P.Columns(col2), P.Columns(col3)))
If Not r Is Nothing Then
  For Each r In r 'si entrées/effacements multiples
    If r <> "" And Not IsDate(r) Then r = "": r.Select
  Next
End If
'---insertion de lignes---
If Not Intersect(Target, P.Offset(1).Columns(col2)) Is Nothing And Target.Count = 1 Then
  Set r = Cells(Target.Row, coldeb).MergeArea
  i = r.Count
  If Application.CountA(r.Offset(, col2 - 1).Resize(i)) = i Then
    Application.ScreenUpdating = True
    n = 1
    Do
      n = Abs(Int(Val(InputBox("Entrer 1 2 ou 3 pour insérer des lignes :", "Insertion", n))))
    Loop While n > 3
    Application.ScreenUpdating = False
    If n Then
      Target(2).EntireRow.Resize(n).Insert
      For j = 0 To nfusion - 1
        r.Offset(, j).Resize(i + n).Merge
      Next
    End If
  End If
End If
'---formule du N° d'ordre pour la MFC couleur---
Set r = Intersect(Target, Range(deb).CurrentRegion)
If r Is Nothing Then GoTo 1
i = Range(deb).Row
For Each r In r 'si entrées/effacements multiples
  Set r = Cells(r.Row, coldeb).MergeArea
  If r.Row > i Then r = IIf(Application.Count(r.Offset(, col3 - 1).Resize(r.Count)), "=MAX(R5C:R[-1]C)+1", "#")
Next
1 With Range(deb).CurrentRegion
  '---suppression des bordures---
  .Resize(Rows.Count - .Row + 1).Borders.LineStyle = xlNone
  '---défusion des cellules sous le tableau si effacements---
  .Offset(.Rows.Count).Resize(Rows.Count - .Rows.Count - .Row + 1).UnMerge
  '---création de nouvelles bordures---
  .Borders.Weight = xlThin
  '---reconstruction de la MFC---
  .Resize(Rows.Count - .Row + 1).FormatConditions.Delete
  Set r = Selection
  .Select 'indispensable sur les versions antérieures à 2007
  .Cells(1) = "=MOD(1/(MATCH(""zzz"",$A$5:$A5)<MATCH(9^9,$A$5:$A5))*MAX($A$5:$A5),2)"
  .FormatConditions.Add xlExpression, Formula1:=.Cells(1).FormulaLocal
  .Cells(1) = "=NOT(MOD(1/(MATCH(""zzz"",$A$5:$A5)<MATCH(9^9,$A$5:$A5))*MAX($A$5:$A5),2))"
  .FormatConditions.Add xlExpression, Formula1:=.Cells(1).FormulaLocal
  .Cells(1) = "N° d'ordre"
  .FormatConditions(1).Interior.ColorIndex = 35 'vert
  .FormatConditions(2).Interior.ColorIndex = 20 'bleu
  r.Select
End With
Application.EnableEvents = True 'réactive les évènements
End Sub
Edit : les formules de la MFC fonctionnent sur versions françaises et étrangères.

Fichier (4).

Bonne journée.
 

Pièces jointes

  • TabStat(4).xls
    94.5 KB · Affichages: 39
Dernière édition:

Discussions similaires

Réponses
45
Affichages
917