Microsoft 365 mettre en forme un tableau par vba

L

Lolo le normand

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

CISCO
  • Question
Microsoft 365 VBA : Transformer une liste de textes en liens.
Réponses
2
Affichages
230
CISCO
CISCO
D
  • Question
XL 2016 Exporter au format PDF dans un dossier existant les colonnes ciblées et en filtrant les lignes qui contiennent une valeur quelconque.
Réponses
6
Affichages
354
Phil69970
Phil69970
O
  • Question
Power Query Convertir un tableau de colonnes en lignes avec plusieurs variables (power query)
Réponses
8
Affichages
365
oobiz
O
D
  • Question
XL 2021 Transformer date format US en date format FR
2
Réponses
15
Affichages
754
Dombal
D
L
  • Question
XL 2021 recherche de valeurs
Réponses
3
Affichages
146
sylvanu
sylvanu
A
  • Question
XL 2019 Filtre avancé en VBA
Réponses
12
Affichages
304
Amilo
A
C
  • Question
Microsoft 365 Modifier un tableau pour reporting
Réponses
5
Affichages
164
alexga78
A
J
  • Question
XL 2019 Filtrage des données dans un TCD
Réponses
10
Affichages
215
Cousinhub
Cousinhub
F
  • Question
XL 2016 tri colonne tableau variable excel vba
Réponses
1
Affichages
171
Dranreb
Dranreb
D
  • Question
Microsoft 365 Problème de format de cellule en VBA
Réponses
11
Affichages
190
David
D

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 43 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 196
Messages
2 086 101
Membres
103 116
dernier inscrit
kutobi87