Microsoft 365 mettre en forme un tableau par vba

L

Lolo le normand

XLDnaute Nouveau
Supporter XLD
Bonjour,
je reçois un export tous les jours que je dois transformer tous les jours pour plusieurs raisons:
  1. je filtre la colonne C équipe pour ne conserver que les lignes où figure Total
  2. les colonnes A et B sont fusionnées, une fois n'avoir gardé que les lignes totales de la colonne C, les deux premières lignes ont pour service abcd_campagne et abcd_plage; toutes les autres cellules de la colonne service contiennent des noms sous le format vf_bd_nom du service. Je souhaite n'avoir qu'une colonne (défusionner A et B) et ne conserver pour les deux premières lignes que ABCD et pour tout le reste que le nom du service.
  3. les colonnes E, O, U contiennent des informations de temps mais sous un format standard j'aimerai transformer ces temps sous le format [H]:mm:ss
  4. les colonnes G, H, S, T contiennent des informations de temps mais sous un format standard que j'aimerai transformer sous le format [mm]
  5. les colonnes V, W et X sont à supprimer
Aujourd'hui je fais tout cela de manière artisanale et si quelqu'un peut m'aider à créer un code VBA pour faire tout cela je gagnerai un temps précieux
Merci d'avance à vous
 

Pièces jointes

  • test téléphone.xlsx
    14 KB · Affichages: 14
Solution
Efgé
Bonjour à tous, Bonjour @Gégé-45550
Je pense que notre ami @Lolo le normand veux aussi que la macro ne soit pas liée à un classeur mais l'avoir à disposition dans son Personal.xlb.
Je propose donc :
VB: 
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...
Trier par date Trier par votes
Gégé-45550

Gégé-45550

XLDnaute Accro
Bonjour,
Ouvrez l'éditeur VBA, c'est le code de la Feuil1(LBP_R6) ... de toute façon, il n'y en a pas d'autre.
VB: 
Private Sub Tri()
Dim LstRow&, i&, j&, K&
Dim TabSource As Variant, TabReport As Variant, Tmp As Variant
Dim Discrit$

Discrit = "CNMR"

With Me
    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)
            Select Case j
'                Case 4, 15, 21
'                    TabReport(K, j - 1) = Format(TabSource(i, j), "[H]hh:mm")
'                Case 7, 8, 19, 20
'                    TabReport(K, j - 1) = Format(TabSource(i, j), "[mm]mm:ss")
                Case Else
                    TabReport(K, j - 1) = TabSource(i, j)
            End Select
        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
Bonne journée.
 
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Bonjour à tous, Bonjour @Gégé-45550
Je pense que notre ami @Lolo le normand veux aussi que la macro ne soit pas liée à un classeur mais l'avoir à disposition dans son Personal.xlb.
Je propose donc :
VB: 
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


Cordialement
 
Vote positif 0 Vote négatif
Solution
L

Lolo le normand

XLDnaute Nouveau
Supporter XLD
Gégé-45550 à dit:
Bonjour,
Ouvrez l'éditeur VBA, c'est le code de la Feuil1(LBP_R6) ... de toute façon, il n'y en a pas d'autre.
VB: 
Private Sub Tri()
Dim LstRow&, i&, j&, K&
Dim TabSource As Variant, TabReport As Variant, Tmp As Variant
Dim Discrit$

Discrit = "CNMR"

With Me
    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)
            Select Case j
'                Case 4, 15, 21
'                    TabReport(K, j - 1) = Format(TabSource(i, j), "[H]hh:mm")
'                Case 7, 8, 19, 20
'                    TabReport(K, j - 1) = Format(TabSource(i, j), "[mm]mm:ss")
                Case Else
                    TabReport(K, j - 1) = TabSource(i, j)
            End Select
        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
Bonne journée.
Cliquez pour agrandir...
je dois vraiment être trop nul je n'arrive pas à l'enregistrer dans mes macros personnelles...
Je ne le retrouve pas quand j'ouvre un fichier pour l'appliquer.
Efgé à dit:
Bonjour à tous, Bonjour @Gégé-45550
Je pense que notre ami @Lolo le normand veux aussi que la macro ne soit pas liée à un classeur mais l'avoir à disposition dans son Personal.xlb.
Je propose donc :
VB: 
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


Cordialement
Cliquez pour agrandir...
Bonjour Efgé oui c'est exactement ça.
Mais je pense encore avoir beaucoup de choses à comprendre dans les macros car je n'arrive pas à l'enregistrer dans mes macros personnelles.
il y a surement un truc que je ne fais pas bien mais je ne trouve pas quoi??
encore merci pour votre patience
Bien à vous
 
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re
Il faut commencer par créer le classeur PERSONAL.XLB :
Tu ouvres un classeur vierge.
Tu clic sur Onglet Développeur
1667209453067.png


Puis Enregistrer une macro:
1667209506109.png

Un pop-up s'ouvre. Choisir Enregistrer la macro dans :
Classeur de macros personnelles
1667209602015.png

Clic sur OK

Tu sélectionne une plage de cellule, n'importe laquelle, puis tu clic sur Arrêter l'enregistrement.
1667209684284.png

Tu fermes ton classeur vierge (tu n'est pas obligé de l'enregistrer).

Ensuite tu fermes Excel (l'application), un pop-up vas te demander si tu veux enregistrer les modifications de ton classeur personnel, clic sur Enregistrer
1667209814825.png


Ensuite tu rouvres Excel et tu reviens pour la suite (la copie du code dans le classeur personnel que tu viens de créer).

Cordialement
 
Dernière édition:
Vote positif 0 Vote négatif
L

Lolo le normand

XLDnaute Nouveau
Supporter XLD
Efgé à dit:
Bonjour à tous, Bonjour @Gégé-45550
Je pense que notre ami @Lolo le normand veux aussi que la macro ne soit pas liée à un classeur mais l'avoir à disposition dans son Personal.xlb.
Je propose donc :
VB: 
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


Cordialement
Cliquez pour agrandir...
RE @Efgé @Gégé-45550
Merci beaucoup à vous deux, cela fonctionne parfaitement et correspond à ce que je voulais!
Désolé encore pour mes maladresses de publication.
La prochaine fois je ferai mieux plus vite
bonne après-midi à vous deux.
 
Vote positif 0 Vote négatif
L

Lolo le normand

XLDnaute Nouveau
Supporter XLD
Efgé à dit:
Re
Il faut commencer par créer le classeur PERSONAL.XLB :
Tu ouvres un classeur vierge.
Tu clic sur Onglet Développeur
Regarde la pièce jointe 1153903

Puis Enregistrer une macro:
Regarde la pièce jointe 1153904
Un pop-up s'ouvre. Choisir Enregistrer la macro dans :
Classeur de macros personnelles
Regarde la pièce jointe 1153905
Clic sur OK

Tu sélectionne une plage de cellule, n'importe laquelle, puis tu clic sur Arrêter l'enregistrement.
Regarde la pièce jointe 1153907
Tu fermes ton classeur vierge (tu n'est pas obligé de l'enregistrer).

Ensuite tu fermes Excel (l'application), un pop-up vas te demander si tu veux enregistrer les modifications de ton classeur personnel, clic sur Enregistrer
Regarde la pièce jointe 1153908

Ensuite tu rouvres Excel et tu reviens pour la suite (la copie du code dans le classeur personnel que tu viens de créer).

Cordialement
Cliquez pour agrandir...
Merci Efgé pour ce pas à pas, j'y suis enfin arrivé
je vais essayer de décortiquer ton code pour comprendre et progresser
Bien à toi
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Question
Microsoft 365 Extraire la totalité du contenu d'une cellule si une cellule commence par un nombre
2
Réponses
16
Affichages
407
PR.
P
M
  • Question
Microsoft 365 Transformer un tableau
Réponses
11
Affichages
356
djidji59430
djidji59430
M
  • Question
XL 2016 Mise en forme conditionnelle
Réponses
11
Affichages
508
Gégé-45550
Gégé-45550
G
  • Question
XL 2016 Chrono VBA minutes secondes
Réponses
10
Affichages
323
Goose
G
G
  • Question
Microsoft 365 Validation des Données
Réponses
3
Affichages
207
AtTheOne
AtTheOne
N
  • Résolu(e)
Microsoft 365 Mettre la 4ème colonne d'une ListBox au format [h]:mm
3 4 5
Réponses
68
Affichages
1 K
NONO14
N
JohnBill
  • Question
XL 2021 Doublons
Réponses
2
Affichages
285
JohnBill
JohnBill
L
  • Question
Microsoft 365 mise en forme fichier excel power query
Réponses
1
Affichages
113
vgendron
vgendron
M
  • Question
XL 2021 Filtres automatiques et tableau trop long à diviser
Réponses
2
Affichages
97
djidji59430
djidji59430
E
  • Question
Microsoft 365 Problème de conversion des mois en périodes dans Excel avec VBA
Réponses
2
Affichages
542
RyuAutodidacte
RyuAutodidacte

Membres actuellement en ligne

14 membres et 182 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 137
Messages
2 116 647
Membres
112 825
dernier inscrit
Mayo