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
L

Lolo le normand

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

L
  • Résolu(e)
XL 2016 mise en forme conditionnelle
Réponses
2
Affichages
252
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
309
Laliepomm
L
A
  • Résolu(e)
XL 2010 date figee et mise en forme conditionnelle
Réponses
3
Affichages
176
Atlas85200
A
M
  • Question
XL 2021 Mise en Forme Conditionnelle avec Formule Complexe
Réponses
4
Affichages
219
sylvanu
sylvanu
I
  • Résolu(e)
XL 2013 Mise en forme conditionnelle avec formule
Réponses
4
Affichages
370
sylvanu
sylvanu
M
  • Résolu(e)
XL 2016 mise en forme conditionnelle
Réponses
7
Affichages
352
TooFatBoy
TooFatBoy
A
  • Question
XL 2016 Mise en forme conditionnelle sur plusieurs lignes
Réponses
2
Affichages
267
Arnauddu44
A
J
  • Question
XL 2021 mise en forme conditionnelle et cellules vides.
Réponses
2
Affichages
207
JOGA
J
R
  • Question
XL 2019 Mise en forme conditionnelle
Réponses
4
Affichages
170
Nain porte quoi
N
A
  • Résolu(e)
Microsoft 365 Correction d'un code vba
2
Réponses
22
Affichages
765
AD95
A

Membres actuellement en ligne

21 membres et 127 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 202
Messages
2 086 180
Membres
103 152
dernier inscrit
Karibu