Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Mise en forme d'un tableau via VBA

L

Lolo le normand

XLDnaute Nouveau
Supporter XLD
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
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

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
Supporter XLD
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

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
Supporter XLD
@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:

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
Supporter XLD
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:

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

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
Supporter XLD
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

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 ???
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Résolu(e)
XL pour MAC Mise en forme conditionnelle dynamique
2 3
Réponses
36
Affichages
1 K
Philarête
F
  • Question
XL 2016 Mise en forme conditionnelle d'une forme (cartographie)
Réponses
9
Affichages
270
francois95
F
S
  • Résolu(e)
Microsoft 365 Vba, Mise en forme d'un calendrier
Réponses
8
Affichages
513
SOP
S
W
  • Résolu(e)
Microsoft 365 VBA Ajouter une colonne à droite avec mise en forme
Réponses
6
Affichages
199
fanch55
C
  • Question
Microsoft 365 Mise en forme conditionnelle sur clic
2
Réponses
22
Affichages
914
TooFatBoy
3
  • Question
XL 2013 modification de la mise en forme à chaque mise à jour de mon graphique croisé dynamique
Réponses
3
Affichages
282
chris
M
  • Question
XL pour MAC Mise en forme conditionnelle sans changer le remplissage des cellules
Réponses
4
Affichages
380
sylvanu
S
  • Résolu(e)
Microsoft 365 Appliquer par vba une mise en forme conditionnelle d'après une liste de cellules mises en forme
Réponses
9
Affichages
616
Dranreb
C
  • Question
Microsoft 365 recopie avec mise en forme
Réponses
6
Affichages
499
Dranreb
W
  • Question
XL 2016 Mise en forme conditionnelle des cellules
Réponses
2
Affichages
235
mapomme
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…