Remonter les infos de cellules fusionnées vers le haut

Le 31/05/2020 à 21:04

Bonjour à tous,

Avec un collègue, nous travaillons sur un fichier excel de suivi journalier. Il n'était pas top, je tente donc de l'améliorer pour le rendre plus fonctionnel et sympa.

Le soir, nous faisons une sauvegarde pdf grâce à un bouton dédié, et le lendemain matin, nous devons effacer certaines cases pour le suivi journalier, mais en conserver d'autres pour un suivi à plus long terme.

J'ai donc créé un bouton "RAZ journalier" qui prend cela en charge. Il efface les cases cochées pour le suivi des missions, les points avec les établissements...

Et parmi tout ça, dans le tableau de suivi des points entées sorties (cellules K32 à AJ59), le RAZ efface les lignes dont la cellule "Réalisé" est non vide, pour ne garder que les autres lignes. Alors, oui, je sais, le code que j'ai créé pour ça est pourri, mais vu que je m'y connais autant en VBA que Kev Adams en littérature biblique du IVe siècle (Kev, si tu me lis, je t'aime beaucoup), le simple fait que ça marche est déjà un exploit, dons soyez indulgents.

Je voudrais que les lignes restantes de ce tableau remontent vers le haut du tableau, au lieu d'être obligé de le faire manuellement. J'ai bien essayé quelques trucs, mais les cellules fusionnées me compliquent la tâche.

J'ai le même souci dans le tableau d'entrée des engins, à gauche. Si la case "Arri" est à "o", et quel que soit l'état de la case "Pris", la ligne est effacée par le RAZ, laissant les engins non arrivés. Je voudrais aussi pouvoir remonter les cellules des engins prévus à l'entrée et le site associé en haut du tableau.

Si vous avez une solution, je suis preneur. Merci d'avance de tout ce que vous pourrez faire pour m'aider. Pour accéder au tableau, sélectionner "Interactive" dans le Userform d'accueil.

Cordialement,

Armelito

19gestion-operationnelle-v2-9.xlsm (621.03 Ko)
Le 31/05/2020 à 21:51

Bonjour,

ric

Le 31/05/2020 à 23:27

Bonjour Armelito,

J'ai bien essayé quelques trucs, mais les cellules fusionnées me compliquent la tâche

Bonne nouvelle, il existe une solution, dans Fusionner et centrer, choisir : annuler fusionner et centrer, puis :

* pour les cellules fusionnées sur plusieurs colonnes : dans alignement choisir, "centrer sur plusieurs colonnes"

* pour les cellules fusionnées en ligne : agrandir la hauteur de la ligne

Bon courage

Christian

Le 01/06/2020 à 01:37

Bonjour,

Un essai ... ""Larga vida a las celdas fusionadas""

Être meilleur ... le code serait peut-être plus beau ... ... M'enfin ... SIC Gaston ...

Code corrigé ...

Private Sub SuiviRAZ_Click()    'vide les cases d'informations jounralières
Dim Cel As Range
Dim Res As Integer
Dim X As Integer
Dim Y As Integer

'''#### <<<< plage Point sur les entrées / sorties >>> Engin

    Application.ScreenUpdating = False
    For X = 34 To 58 Step 2         ' <<< vide la plage K34: AJ59 si W est vide
        If Range("W" & X) <> "" Then Range("K" & X & ":AJ" & X + 1).ClearContents             ' Vide les cellules de la 1ère ligne de libération si l'engin est libéré
    Next X

    Application.DisplayAlerts = False       ' désactiver les alertes le temps des copies
    Application.EnableEvents = False
    Y = 34
Reprises1:
    For X = 34 To 56 Step 2     ' remonte les lignes restantes de la plage AC:AE 1re ligne
        Res = 0
        For Each Cel In Range("AC" & X & ":Aj" & X + 1)
            Res = Res + Cel.Value
        Next Cel
        If Res = 0 Then
            Range("AC" & X + 2 & ":AE" & X + 2).Copy
            Range("AC" & X & ":AE" & X).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("AC" & X + 2 & ":AE" & X + 2).ClearContents
                                 ' remonte les lignes restantes de la plage AF:AJ  1re ligne
            Range("AF" & X + 2 & ":AJ" & X + 2).Copy
            Range("AF" & X & ":AJ" & X).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("AF" & X + 2 & ":AJ" & X + 2).ClearContents
                                 ' remonte les lignes restantes de la plage AC:AJ 2e ligne
            Range("AC" & X + 3 & ":AJ" & X + 3).Copy
            Range("AC" & X + 1 & ":AJ" & X + 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("AC" & X + 3 & ":AJ" & X + 3).ClearContents
        End If
    Next X

    Y = Y + 2
    If Y < 56 Then GoTo Reprises1

    Y = 34
Reprises2:
    For X = 34 To 56 Step 2
        If Range("K" & X) = "" Then
            Range("K" & X + 2 & ":L59").Copy       ' remonter les lignes restantes de la plage K:L
            Range("K" & X & ":L" & X).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("K58:L59").ClearContents

            Range("M" & X + 2 & ":P59").Copy       ' remonter les lignes restantes de la plage M:P
            Range("M" & X & ":P" & X).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("M58:P59").ClearContents

            Range("Q" & X + 2 & ":AB59").Copy     ' remonter les lignes restantes de la plage Q:AB
            Range("Q" & X & ":AB" & X).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("Q58:AB59").ClearContents
        End If
    Next X

    Y = Y + 2
    If Y < 56 Then GoTo Reprises2

'''#### <<<< plage Point sur les entrées / sorties >>> Les Arrivées
    For X = 34 To 58 Step 2                         ' vide les arrivées
        If Range("H" & X) = "o" Then Range("B" & X & ":I" & X + 1).ClearContents          ' Vide les cellules de la 1ère ligne d'entrée si l'engin est entré
    Next X

    Y = 34
Reprises3:
    For X = 34 To 56 Step 2             ' remonter les lignes restantes de la plage B:E
        If Range("B" & X) = "" Then
            Range("B" & X + 2 & ":E59").Copy
            Range("B" & X & ":E" & X).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("B58:E59").ClearContents

            Range("F" & X + 2 & ":G59").Copy
            Range("F" & X & ":G" & X).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("F58:G59").ClearContents

            Range("H" & X + 2 & ":I59").Copy
            Range("H" & X & ":I" & X).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("H58:I59").ClearContents
        End If
    Next X
    Y = Y + 2
    If Y < 56 Then GoTo Reprises3

'''#### <<<< plage Acheminements <<<<<<
    For X = 65 To 71        ' vide les lignes de la plage sous condition
        If Range("AI" & X) = "o" Then Range("B" & X & ":AJ" & X).ClearContents           ' Vide les cellules de la 1ère ligne d'acheminement si l'engin est arrivé
    Next X

    Y = 34
Reprises6:
    For X = 65 To 70              ' remonter les lignes restantes de la plage AI:AJ
        If Range("AI" & X) <> "n" Then
            Range("AI" & X + 1 & ":AJ71").Copy
            Range("AI" & X & ":AJ" & X).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("AI71:AJ71").ClearContents

            Range("B" & X + 1 & ":F71").Copy
            Range("B" & X & ":F" & X).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("B71:F71").ClearContents

            Range("G" & X + 1 & ":L71").Copy
            Range("G" & X & ":L" & X).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("G71:L71").ClearContents

            Range("M" & X + 1 & ":S71").Copy
            Range("M" & X & ":S" & X).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("M71:S71").ClearContents

            Range("T" & X + 1 & ":U71").Copy
            Range("T" & X & ":U" & X).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("T71:U71").ClearContents

            Range("V" & X + 1 & ":AA71").Copy
            Range("V" & X & ":AA" & X).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("V71:AA71").ClearContents

            Range("AB" & X + 1 & ":AH71").Copy
            Range("AB" & X & ":AH" & X).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("AB71:AH71").ClearContents
        End If
    Next X
    Y = Y + 1
    If Y < 71 Then GoTo Reprises6

    Range("C13:E15, O13:Q15, AA13:AC15, C19:E21, O19:Q21, AA19:AC21, C25:E28, O25:Q28, AA25:AC28").ClearContents    'Efface les cases dépôts du point entrées/sorties
    Range("K13:L15, W13:X15, AI13:AJ15, K19:L21, W19:X21, AI19:AJ21, K25:L28, W25:X28, AI25:AJ28").ClearContents    'Efface les cases Activités du point entrées sorties
    Range("AV19:AX21").ClearContents    'Efface les cases de libération en mode dégradé
    Range("AS26:AT37, AU34:AV43, AS44:AT49, AU46:AV51, AS52:AT53").ClearContents    'Efface les cases de validation des missions
    Range("K11, W11, AI11, K17, W17, AI17, K23, W23, AI23").Value = "Oui"    'Remet les cellules des activités à "Oui"

    Application.DisplayAlerts = True        ' réactive les alertes
    Application.EnableEvents = True
End Sub

ric

Le 01/06/2020 à 09:22

Bonjour Christian,

Quand je parlais de problèmes avec les cellules fusionnées, c'était concernant la remontée des valeurs de cellules dans le tableau, car certaines cellules sont fusionnées sur 2 lignes, et d'autres sur une seule.

Bonjour Ric,

J'ai recopié ton code, Les cases cochées sont bien décochées, et les lignes validées s'effacent bien dans les 3 parties du fichier.

Mais le code crée aussi les problèmes suivants :

  • Toutes les lignes du tableau des entrées d'engins sont effacées sans distinction.
  • Les lignes réalisées du tableau de suivi des points entées sorties sont bien effacées, lors du 1er appui sur le bouton, les données ne sont pas complètement remontées, il reste une ligne entre certaines. Je dois appuyer une 2e fois pour que les données remontent correctement.
  • Les lignes à "o" du tableau d'acheminement sont bien effacées, mais les données ne remontent pas.
situation apres 1 raz situation apres 2 raz situation d origine
3gestion-operationnelle-v2-9-modifie.xlsm (621.51 Ko)
Le 01/06/2020 à 13:21

Bonjour,

Je crois que ça fonctionne mieux ...

J'ai remplacé le code de mon post précédent ...

https://forum.excel-pratique.com/viewtopic.php?p=875400#p875400

ric

Le 01/06/2020 à 16:04

C'est absolument génial !

ça marche impeccable, c'est super !

Vraiment merci beaucoup, ric, tu es trop fort, et rapide à répondre, avec ça !

Merci pour ton aide, je met ce fichier en service dès demain matin.

Bonne continuation et encore chapeau bas.

Cordialement,

Armelito.

Le 01/06/2020 à 16:05

ric

Le 02/06/2020 à 07:19

Bonjour ric,

Désolé de te déranger de nouveau, mais je viens de tester mon fichier au boulot, et j'ai un nouveau souci.

Il semblerait que si les valeurs dans les cellules "Opérations" et "Observations sont composées de lettres, le RAZ me mette un bug.

Il fonctionne avec des cellules vides ou avec des valeurs numériques, mais avec des valeurs alphabétiques, ça plante et je reçois un message d'erreur type 13 pour une incompatibilité de type..

Ton code étant bien au-delà de mes compétences, je n'arrive pas à le bébuguer moi-même.

Pouurais-tu m'aider STP ?

Merci d'avance.

incompatibilite de type
Le 02/06/2020 à 11:13

Bonjour,

Une toute petite correction ... Une seule ligne à modifier ainsi ...

Reprises1:
    For X = 34 To 56 Step 2     ' remonte les lignes restantes de la plage AC:AE 1re ligne
        Res = 0
        For Each Cel In Range("AC" & X & ":Aj" & X + 1)
            If Cel <> "" Then Res = Res + 1     ' << Corriger cette ligne
        Next Cel

ric

Le 02/06/2020 à 14:42

Bonjour ric,

On dirait que ça fonctionne

Je vais continuer de le tester cette semaine, et si tout va bien, on mettra ça en service.

Merci beaucoup pour ton aide.

cordialement,

Armelito

Rechercher des sujets similaires à "remonter infos fusionnees haut"