Microsoft 365 Mise en forme d'un tableau via VBA

L

Lolo le normand

XLDnaute Nouveau
Bonsoir à tous,

je vous sollicite à nouveau pour une mise en forme d'un tableau via une macro à enregistrer dans mes macros personnelles.

Je vous joins un fichier anonymisé en exemple avec l'onglet 1(activite_agent) qui est le fichier d'origine avec un deuxième onglet qui est la mise en forme souhaitée:
1) supprimer la première ligne
2) dans la colonne C supprimer toutes les lignes qui ne contiennent pas total
3) dé-fusionner les colonnes C, D, E et F.
4) colonne A:
- remplacer Chalons par CNMR(maj)
- Remplacer Clermont par CNMR(maj)
- Supprimer le préfixe Site_SC_ pour ne garder que le suffixe
- supprime le préfixe Site_SD_ pour ne garde que le suffixe (dans le fichier il n'y en a pas mais suivant les journées il peut y en avoir)
5) Supprimer les colonnes T et U.

J'espère grâce à vous et votre site y arriver seul un jour.

En tous les cas merci d'avance à vous tous pour votre aide
Bonne soirée
 

Pièces jointes

  • Copie de 06___Activite_des_agents_anonyme.xls
    275 KB · Affichages: 18
Solution
cp4
Lolo le normand à dit:
bonjour @cp4 @TooFatBoy
voilà des copies d'écran
Regarde la pièce jointe 1154398
Regarde la pièce jointe 1154400
Regarde la pièce jointe 1154401
voilà ce qui se produit j'ai bien changé le nom qui est toujours activite_agent dans les mails que je reçois chaque jour avec ce rapport.
je suis bien dans mes macros personnelles
du coup je ne comprends pas
Cliquez pour agrandir...
essaie avec ce code modifié
VB: 
Option Explicit

Sub Mise_En_Forme3()
   Dim nb As Integer, i As Integer, tb
   Dim Plg As Range

  
   With ActiveSheet
      .Rows(1).Delete   'supprimer 1ère ligne
      ' supprimer les lignes visibles du filtre dont critère en colonne 3 est différent de total
      Set Plg = .Range("A1:U" & .Range("A" & Rows.Count).End(xlUp).Row)
      Plg.AutoFilter field:=3, Criteria1:="<>*TOTAL*"...
Trier par date Trier par votes
cp4

cp4

XLDnaute Barbatruc
Bonjour @Lolo le normand ;), @OKBI :),

un essai à tester.
VB: 
Option Explicit

Sub Mise_En_Forme()
   Dim F As Worksheet, nb As Integer, i As Integer, tb

   Set F = ThisWorkbook.Sheets("activite_agent (2)") '**nom feuille à adapter**
   With F
      .Rows(1).Delete
      nb = .Cells(Rows.Count, 3).End(xlUp).Row
      For i = nb To 2 Step -1
         If .Cells(i, 3) <> "TOTAL" Then .Rows(i).Delete
      Next i

      nb = .Cells(Rows.Count, 1).End(xlUp).Row

      For i = 1 To nb
         If .Cells(i, 3).MergeCells Then .Cells(i, 3).UnMerge
         If .Cells(i, 19).MergeCells Then .Cells(i, 19).UnMerge

         If .Cells(i, 3).Offset(0, -2) = "Chalons" Then .Cells(i, 3).Offset(0, -2) = "CNMR"
         If .Cells(i, 3).Offset(0, -2) = "Clermont" Then .Cells(i, 3).Offset(0, -2) = "CNMR"

         tb = Split(.Cells(i, 3).Offset(0, -2), "_")
         If UBound(tb) <> 0 Then .Cells(i, 3).Offset(0, -2) = tb(UBound(tb))
      Next i
      .Columns("T:U").Delete Shift:=xlToLeft
   End With
   MsgBox "Traitement terminé!"
End Sub
Bonne journée
 
Dernière édition:
Vote positif 0 Vote négatif
L

Lolo le normand

XLDnaute Nouveau
cp4 à dit:
Bonjour @Lolo le normand ;), @OKBI :),

un essai à tester.
VB: 
Option Explicit

Sub Mise_En_Forme()
   Dim F As Worksheet, nb As Integer, i As Integer, tb

   Set F = ThisWorkbook.Sheets("activite_agent (2)") '**nom feuille à adapter**
   With F
      .Rows(1).Delete
      nb = .Cells(Rows.Count, 3).End(xlUp).Row
      For i = nb To 2 Step -1
         If .Cells(i, 3) <> "TOTAL" Then .Rows(i).Delete
      Next i

      nb = .Cells(Rows.Count, 1).End(xlUp).Row

      For i = 1 To nb
         If .Cells(i, 3).MergeCells Then .Cells(i, 3).UnMerge
         If .Cells(i, 19).MergeCells Then .Cells(i, 19).UnMerge

         If .Cells(i, 3).Offset(0, -2) = "Chalons" Then .Cells(i, 3).Offset(0, -2) = "CNMR"
         If .Cells(i, 3).Offset(0, -2) = "Clermont" Then .Cells(i, 3).Offset(0, -2) = "CNMR"

         tb = Split(.Cells(i, 3).Offset(0, -2), "_")
         If UBound(tb) <> 0 Then .Cells(i, 3).Offset(0, -2) = tb(UBound(tb))
      Next i
      .Columns("T:U").Delete Shift:=xlToLeft
   End With
   MsgBox "Traitement terminé!"
End Sub
Bonne journée
Cliquez pour agrandir...
Bonsoir,

J'ai ce bug sur votre code Set F = ThisWorkbook.Sheets("activite_agent")
j'ai adapté le nom de la feuille mais j'ai dû me tromper dans l'écriture.
Sachant que le nom de la feuille est toujours activite_agent.
Merci pour votre éclairage
Bien à vous
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
Bonjour,

@Lolo le normand : Un peu plus rapide, on supprime les lignes non concernées d'un coup. Dans le précédent code on utilisait une boucle sur toutes les lignes d'où un temps plus long d’exécution.
VB: 
Option Explicit

Sub Mise_En_Forme2()
   Dim F As Worksheet, nb As Integer, i As Integer, tb
   Dim Plg As Range

   Set F = ThisWorkbook.Sheets("activite_agent (2)") 'nom feuille à adapter
   With F
      .Rows(1).Delete   'supprimer 1ère ligne
      ' supprimer les lignes visibles du filtre dont critère en colonne 3 est différent de total
      Set Plg = .Range("A1:U" & .Range("A" & Rows.Count).End(xlUp).Row)
      Plg.AutoFilter field:=3, Criteria1:="<>*TOTAL*"   'application du filtre
      Application.DisplayAlerts = False   'désactivation message d'alerte suppression
      Plg.Offset(1).SpecialCells(xlCellTypeVisible).Delete   'suppression des lignes
      Application.DisplayAlerts = True
      .AutoFilterMode = False   'désactivation filtre
      '------------------
      nb = .Cells(Rows.Count, 1).End(xlUp).Row 'derniere ligne non vide en colonne 1

      For i = 1 To nb
         If .Cells(i, 3).MergeCells Then .Cells(i, 3).UnMerge
         If .Cells(i, 19).MergeCells Then .Cells(i, 19).UnMerge
         If .Cells(i, 3).Offset(0, -2) = "Chalons" Then .Cells(i, 3).Offset(0, -2) = "CNMR"
         If .Cells(i, 3).Offset(0, -2) = "Clermont" Then .Cells(i, 3).Offset(0, -2) = "CNMR"

         tb = Split(.Cells(i, 3).Offset(0, -2), "_")
         If UBound(tb) <> 0 Then .Cells(i, 3).Offset(0, -2) = tb(UBound(tb))
      Next i
      .Columns("T:U").Delete Shift:=xlToLeft
   End With
   MsgBox "Traitement terminé!"
End Sub
 
Vote positif 0 Vote négatif
L

Lolo le normand

XLDnaute Nouveau
cp4 à dit:
Bonjour,

@Lolo le normand : Un peu plus rapide, on supprime les lignes non concernées d'un coup. Dans le précédent code on utilisait une boucle sur toutes les lignes d'où un temps plus long d’exécution.
VB: 
Option Explicit

Sub Mise_En_Forme2()
   Dim F As Worksheet, nb As Integer, i As Integer, tb
   Dim Plg As Range

   Set F = ThisWorkbook.Sheets("activite_agent (2)") 'nom feuille à adapter
   With F
      .Rows(1).Delete   'supprimer 1ère ligne
      ' supprimer les lignes visibles du filtre dont critère en colonne 3 est différent de total
      Set Plg = .Range("A1:U" & .Range("A" & Rows.Count).End(xlUp).Row)
      Plg.AutoFilter field:=3, Criteria1:="<>*TOTAL*"   'application du filtre
      Application.DisplayAlerts = False   'désactivation message d'alerte suppression
      Plg.Offset(1).SpecialCells(xlCellTypeVisible).Delete   'suppression des lignes
      Application.DisplayAlerts = True
      .AutoFilterMode = False   'désactivation filtre
      '------------------
      nb = .Cells(Rows.Count, 1).End(xlUp).Row 'derniere ligne non vide en colonne 1

      For i = 1 To nb
         If .Cells(i, 3).MergeCells Then .Cells(i, 3).UnMerge
         If .Cells(i, 19).MergeCells Then .Cells(i, 19).UnMerge
         If .Cells(i, 3).Offset(0, -2) = "Chalons" Then .Cells(i, 3).Offset(0, -2) = "CNMR"
         If .Cells(i, 3).Offset(0, -2) = "Clermont" Then .Cells(i, 3).Offset(0, -2) = "CNMR"

         tb = Split(.Cells(i, 3).Offset(0, -2), "_")
         If UBound(tb) <> 0 Then .Cells(i, 3).Offset(0, -2) = tb(UBound(tb))
      Next i
      .Columns("T:U").Delete Shift:=xlToLeft
   End With
   MsgBox "Traitement terminé!"
End Sub
Cliquez pour agrandir...
@cp4 Bonjour et merci,
j'ai collé ce nouveau code mais j'ai toujours un bug sur le début du code que je ne comprends pas:
1667559753233.png

c'est pourtant le bon nom de la feuille.
Pouvez vous m'éclairer
Merci d'avance
Bien à vous
 
Vote positif 0 Vote négatif
L

Lolo le normand

XLDnaute Nouveau
TooFatBoy à dit:
Bonjour,


Tu as copié le nom dans l'onglet, pour ensuite le coller dans la macro (ou inversement) ?
Cliquez pour agrandir...
@TooFatBoy j'ai copié le code dans mes macros perso j'ai ouvert mon fichier et j'ai lancé la macro.
J'ai eu la fénêtre débogage donc j'ai copié le nom de l'onglet dans le code de la macro mais ça ne fonctionne toujours pas.
Le nom de l'onglet est toujours le même (c'est une extraction que je reçois tous les matins et le nom de l'onglet est toujours le même

j'ai ce message d'erreur:
1667563461176.png

bien cordialement
 
Dernière édition:
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Que je comprenne bien, tu as copié le nom de la feuille depuis l'onglet, puis tu l'as collé dans la macro, et alors le message d'erreur à changé ???
Ça veut donc dire qu'avant ça le nom de la feuille n'était pas le bon dans la macro.

Tu as un seul classeur ouvert ?
 
Vote positif 0 Vote négatif
L

Lolo le normand

XLDnaute Nouveau
TooFatBoy à dit:
Que je comprenne bien, tu as copié le nom de la feuille depuis l'onglet, puis tu l'as collé dans la macro, et alors le message d'erreur à changé ???
Ça veut donc dire qu'avant ça le nom de la feuille n'était pas le bon dans la macro.

Tu as un seul classeur ouvert ?
Cliquez pour agrandir...
Oui car si tu regardes dans le code écrit par @cp4 le nom de la feuille est "à adapter" mais en réalité il porte toujours le même nom le même que celui que tu trouves dans mon fichier d'origine.
Et oui j'ai qu'un seul classeur Excell ouvert
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Je viens d'allumer mon PC pour tester, et chez moi il n'y a pas de message d'erreur.

En revanche, si je mets un nom de feuille qui n'existe pas, j'ai bien le même message qu'en #11. ;)
(j'utilise Excel 2016)


Remarque : tu utilises Excel 365 et tu enregistres ton classeur au format Excel 97 ??? :oops:
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

L
  • Résolu(e)
XL 2016 mise en forme conditionnelle
Réponses
2
Affichages
251
litchoutsou
L
L
  • Résolu(e)
Microsoft 365 VBA - Attribuer mise en forme en fonction de valeur cellule d'une liste
Réponses
14
Affichages
303
Laliepomm
L
A
  • Résolu(e)
XL 2010 date figee et mise en forme conditionnelle
Réponses
3
Affichages
174
Atlas85200
A
M
  • Question
XL 2021 Mise en Forme Conditionnelle avec Formule Complexe
Réponses
4
Affichages
218
sylvanu
sylvanu
I
  • Résolu(e)
XL 2013 Mise en forme conditionnelle avec formule
Réponses
4
Affichages
368
sylvanu
sylvanu
M
  • Résolu(e)
XL 2016 mise en forme conditionnelle
Réponses
7
Affichages
350
TooFatBoy
TooFatBoy
A
  • Question
XL 2016 Mise en forme conditionnelle sur plusieurs lignes
Réponses
2
Affichages
264
Arnauddu44
A
J
  • Question
XL 2021 mise en forme conditionnelle et cellules vides.
Réponses
2
Affichages
199
JOGA
J
R
  • Question
XL 2019 Mise en forme conditionnelle
Réponses
4
Affichages
144
Nain porte quoi
N
A
  • Résolu(e)
Microsoft 365 Correction d'un code vba
2
Réponses
22
Affichages
757
AD95
A

Membres actuellement en ligne

4 membres et 108 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 177
Messages
2 085 972
Membres
103 073
dernier inscrit
MSCHOE16