Remonter les infos de cellules fusionnées vers le haut
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
Bonjour,
ric
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
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
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.
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
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.
ric
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.
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
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