Microsoft 365 mettre en forme un tableau par vba

Lolo le normand · 23 Octobre 2022

Bonjour,
je reçois un export tous les jours que je dois transformer tous les jours pour plusieurs raisons:

je filtre la colonne C équipe pour ne conserver que les lignes où figure Total
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.
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
les colonnes G, H, S, T contiennent des informations de temps mais sous un format standard que j'aimerai transformer sous le format [mm]
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

Efgé · 31 Octobre 2022

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

Gégé-45550 · 31 Octobre 2022

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.

Efgé · 31 Octobre 2022

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

Lolo le normand · 31 Octobre 2022

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.

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

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

Efgé · 31 Octobre 2022

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

Puis Enregistrer une macro:

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

Clic sur OK

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

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

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

Lolo le normand · 31 Octobre 2022

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

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.

Lolo le normand · 31 Octobre 2022

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

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

Microsoft 365 mettre en forme un tableau par vba

Lolo le normand

XLDnaute Nouveau

Pièces jointes

Efgé

Gégé-45550

XLDnaute Accro

Efgé

XLDnaute Barbatruc

Lolo le normand

XLDnaute Nouveau

Efgé

XLDnaute Barbatruc

Lolo le normand

XLDnaute Nouveau

Lolo le normand

XLDnaute Nouveau

Discussions similaires