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
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
L

Lolo le normand

XLDnaute Nouveau
Supporter XLD
TooFatBoy à dit:
Je te retourne le classeur, mais enregistré au format xlsm. ;)

C'est ton classeur de #1, avec la macro de cp4 intégrée dans un module.
Cliquez pour agrandir...
merci @TooFatBoy
Mais j'aimerai comprendre la différence j'ai ce code que j'utilise tous les matins sur un autre fichier mais de format identique en .xls
Sub MiseEnForme()
Dim LstRow&, i&, j&, K&
Dim TabSource As Variant, TabReport As Variant, Tmp As Variant
Dim Discrit$

Discrit = "CNMR"

With ActiveSheet
LstRow = .Cells(.Rows.Count, 1).End(xlUp).Row
TabSource = .Range(.Cells(1, 1), .Cells(LstRow, 21))
K = Application.CountIf(.Columns("c"), "Total") + 1
End With
ReDim TabReport(1 To K, 1 To 21)
K = 1
TabReport(1, 1) = TabSource(1, 1)
For i = 3 To UBound(TabSource, 2)
TabReport(1, i - 1) = TabSource(1, i)
Next i
For i = LBound(TabSource, 1) + 1 To UBound(TabSource, 1)
If TabSource(i, 3) = "Total" Then
K = K + 1
Tmp = Split(TabSource(i, 1), "_")
Select Case Tmp(LBound(Tmp))
Case Discrit
TabReport(K, 1) = Tmp(LBound(Tmp))
Case Else
TabReport(K, 1) = Tmp(UBound(Tmp))
End Select
For j = 3 To UBound(TabSource, 2)
TabReport(K, j - 1) = TabSource(i, j)
Next j
End If
Next i

With Sheets.Add(after:=Sheets(Sheets.Count))
.Name = "MiseEnForme_" & Sheets.Count - 1
.Cells(1, 1).Resize(UBound(TabReport, 1), UBound(TabReport, 2)).Value = TabReport
.Columns.AutoFit
End With

End Sub

Il fonctionne sans enregistrer en format xlsm.
Pour ma culture peut tu me dire la différence stp
Désolé pour toutes ces questions mais je débute
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Pour rendre ton code plus lisible sur le forum, tu peux utiliser la balise code=vb ;)

La différence entre .xls et .xlsm, c'est la version d'Excel.
.xls c'est pour Excel 2003 et précédents.
.xlsm c'est pour les versions après Excel 2003. (le m est pour dire qu'il y a prise en charge des marcos, sinon c'est .xlsx)

J'ai enregistré au format actuel par ce que tu es sous Excel 365.
Toutefois, tu peux garder le vieux format, mais ce serait dommage, voire stupide...
 
Dernière édition:
Vote positif 0 Vote négatif
L

Lolo le normand

XLDnaute Nouveau
Supporter XLD
TooFatBoy à dit:
Pour rendre ton code plus lisible sur le forum, tu peux utiliser la balise code=vb ;)

La différence entre .xls et .xlsm, c'est la version d'Excel.
.xls c'est pour Excel 2003 et précédents.
.xlsm c'est pour les versions après Excel 2003. (le m est pour dire qu'il y a prise en charge des marcos, sinon c'est .xlsx)

J'ai enregistré au format actuel par ce que tu es sous Excel 365.
Toutefois, tu peux garder le vieux format, mais ce serait dommage, voire stupide...
Cliquez pour agrandir...
le fichier que tu m'as envoyé oui mais quand je prends mon fichier activite_agent que j'ai reçu par mail aujourd'hui cela ne fonctionne pas
même si je l'enregistre en xlsm
:(
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Chez moi tout fonctionne correctement.

Je ne connais pas la fonctionnalité d'Excel que tu sembles utiliser : mettre une macro dans tes macros personnelles. Peut-être que le souci vient de là.
Si quelqu'un peut nous renseigner sur ce point, je suis preneur. Merci par avance.

Moi je colle simplement la macro dans la feuille et ça fonctionne.
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
Bonjour @TooFatBoy ;), @Lolo le normand ;),

@TooFatBoy : merci d'avoir pris le relais👍

@Lolo le normand : Sur ma machine Win7 6 bits et Excel2010 32 bits, tout fonctionne.
Je t'ai demandé d'adapter le nom de la feuille car j'ai travaillé sur une copie de ta feuille initiale.
En effet, pour mes tests j'aurai perdu toutes les données à virer.

Comme te l'a indiqué TooFatBoy si la feuille n'existe pas dans le classeur ou que le nom est mal orthographié alors il y a cette erreur.

Tu nous dis plus que tu as enregistré la macro dans tes macros perso. Je ne comprends pas une macro perso a l'extension .xlam.

Dis-nous si le code lève cette erreur dans le fichier joint de @TooFatBoy, qui a pour extension .xlsm?

A+

Edit: en retour ton fichier en xls, le code fonctionne parfaitement.
remplace Thisworkbook par Activeworkbook et fais un essai.

Sinon importe le module dans le fichier concerné et exécute le code.
 

Pièces jointes

  • Copie de 06___Activite_des_agents_anonyme.xls
    533.5 KB · Affichages: 1
Dernière édition:
Vote positif 0 Vote négatif
L

Lolo le normand

XLDnaute Nouveau
Supporter XLD
cp4 à dit:
Bonjour @TooFatBoy ;), @Lolo le normand ;),

@TooFatBoy : merci d'avoir pris le relais👍

@Lolo le normand : Sur ma machine Win7 6 bits et Excel2010 32 bits, tout fonctionne.
Je t'ai demandé d'adapter le nom de la feuille car j'ai travaillé sur une copie de ta feuille initiale.
En effet, pour mes tests j'aurai perdu toutes les données à virer.

Comme te l'a indiqué TooFatBoy si la feuille n'existe pas dans le classeur ou que le nom est mal orthographié alors il y a cette erreur.

Tu nous dis plus que tu as enregistré la macro dans tes macros perso. Je ne comprends pas une macro perso a l'extension .xlam.

Dis-nous si le code lève cette erreur dans le fichier joint de @TooFatBoy, qui a pour extension .xlsm?

A+
Cliquez pour agrandir...
bonjour @cp4 @TooFatBoy
voilà des copies d'écran
1667580810372.png

1667580858845.png

1667580919650.png

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
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
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*"   '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
A+
 
Vote positif 1 Vote négatif
Solution
L

Lolo le normand

XLDnaute Nouveau
Supporter XLD
cp4 à dit:
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*"   '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
A+
Cliquez pour agrandir...
@cp4 @TooFatBoy Merci à vous deux ce code fonctionne parfaitement CP4
Pour ma progression tu as enlevé le nom de la feuille et tu l'as remplacé par quoi?
bien à toi
 
Vote positif 0 Vote négatif

Discussions similaires

Philarête
  • Résolu(e)
XL pour MAC Mise en forme conditionnelle dynamique
2 3
Réponses
36
Affichages
1 K
Philarête
Philarête
F
  • Question
XL 2016 Mise en forme conditionnelle d'une forme (cartographie)
Réponses
9
Affichages
267
francois95
F
S
  • Résolu(e)
Microsoft 365 Vba, Mise en forme d'un calendrier
Réponses
8
Affichages
495
SOP
S
W
  • Résolu(e)
Microsoft 365 VBA Ajouter une colonne à droite avec mise en forme
Réponses
6
Affichages
191
fanch55
fanch55
C
  • Question
Microsoft 365 Mise en forme conditionnelle sur clic
2
Réponses
22
Affichages
897
TooFatBoy
TooFatBoy
3
  • Question
XL 2013 modification de la mise en forme à chaque mise à jour de mon graphique croisé dynamique
Réponses
3
Affichages
274
chris
chris
M
  • Question
XL pour MAC Mise en forme conditionnelle sans changer le remplissage des cellules
Réponses
4
Affichages
365
sylvanu
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
614
Dranreb
Dranreb
C
  • Question
Microsoft 365 recopie avec mise en forme
Réponses
6
Affichages
487
Dranreb
Dranreb
W
  • Question
XL 2016 Mise en forme conditionnelle des cellules
Réponses
2
Affichages
228
mapomme
mapomme

Membres actuellement en ligne

2 membres et 32 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
315 087
Messages
2 116 083
Membres
112 654
dernier inscrit
SADIKA