Suppression de colonnes

B

brahim224

XLDnaute Nouveau
Bonjour à toutes et à tous,

J’ai parcouru le forum à la recherche de macro VBA pour résoudre mon problème et je n’en ai pour l’instant pas trouvé. Je sollicite vivement votre aide.

Mon problème est le suivant :

J’ai un tableau Excel contenant plusieurs colonnes et plusieurs lignes. Les données disponibles sur le fichier sont importées depuis un ERP et c’est des données mensuelles. J’ai donc 4 exercices sur le fichier sachant qu’un exercice fait 12 mois (soit 48 mois au total). L’ERP permet d’exporter seulement 4 mois à la fois, j’ai donc fait autant d’exportation que nécessaire pour avoir tous les 48 mois et les mettre sur la même feuille. Le souci est qu’à chaque exportation, j’ai une colonne qui se répète (la colonne contenant la liste des éléments) et ensuite j’ai certaines lignes qui se sont rajoutés sur certaines exportations tout simplement parce que c’est de nouveaux éléments qui n’existaient pas sur les autres mois.

Ce que je voudrais donc :

C’est d’éliminer les colonnes « éléments » pour ne garder qu’une seule au début, aligner les colonnes des mois ensuite. Si j’ai une ligne xxx qui s’est ajouté sur mars 2021 par exemple et qui n’existait pas sur janvier, mettre 00 dans la cellule de janvier correspondante à cette ligne-là.

Je vous joins le fichier pour vous donner une idée plus précise de ce je voudrais

Merci pour votre aide !

Cordialement,
 

Pièces jointes

  • Fichier_a_analyser.xlsx
    212.3 KB · Affichages: 8
Trier par date Trier par votes
K

Katido

XLDnaute Occasionnel
Bonjour,
Je te propose ce fichier, qui contient une petite macro.
J'ai réutilisé tes données (dans la feuille 1), avec une copie des valeurs pour avoir des valeurs figées et non des valeurs aléatoires ce qui permet de mieux tester.

J'ai crée une feuille "Import" et une feuille "Résultat".

Chaque fois qu'on a des nouvelles données (en principe tous les 4 mois), il faut placer ces données (avec la colonne éléments bien sûr) dans la feuille "Import". Ensuite, on va dans la feuille "Résultat" et on clique sur le bouton "Ajout des données de la feuille 'Import'". Les données doivent s'ajouter automatiquement.

Les nouvelles colonnes avec les mois sont créées automatiquement

Il y a 3 cas de figure pour chaque élément :
- l'élément des nouvelles données existait déjà : les données sont ajoutées dans les nouvelles colonnes
- l'élément des nouvelles données est nouveau et n'existait donc pas : une ligne est créée avec des 0,00 dans les anciennes colonnes. J'ai mis les cellules concernées en rouge pour tester les modifs.
- les nouvelles données ne contiennent pas un élément qui existait auparavant. Les cellules concernées restent vides

J'ai testé avec toutes les données d'octobre 2018 à mars 2022, ça m'a l'air bon.
J'ai tenu compte du fait que certains éléments pouvaient apparaitre 2 fois (par exemple "Coût d'achats marchandises vendues")

On remarque qu'il y a beaucoup de nouveaux éléments à partir d'octobre 2021
 

Pièces jointes

  • Fichier_a_analyser.xlsm
    391.5 KB · Affichages: 9
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour brahim224, bienvenue sur XLD, bonjour Katido,

Voyez le fichier joint et cette macro dans le code de la feuille "Résultat" :
VB: 
Private Sub Worksheet_Activate()
Dim tablo, nlig&, ncol%, dercol%, d As Object, j%, i&, x$, n&, resu(), a, nn&, k%
tablo = Sheets("Feuil1").[A1].CurrentRegion 'matrice, plus rapide
nlig = UBound(tablo)
ncol = UBound(tablo, 2)
dercol = 46 'colonne AT, à adapter
'---liste des élémenrs sans doublon---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For j = 1 To dercol Step 5 'colonnes A, F,...AT
    For i = 2 To nlig
        x = tablo(i, j)
        If Not d.exists(x) Then n = n + 1: d(x) = n 'mémorise le rang
Next i, j
If n = 0 Then GoTo 1 'si le tableau est vide
'---tableau des résultats---
ReDim resu(1 To n, 1 To ncol)
a = d.keys
For i = 1 To UBound(resu)
    resu(i, 1) = a(i - 1)
Next i
For j = 1 To dercol Step 5 'colonnes A, F,...AT
    For i = 2 To nlig
        nn = d(tablo(i, j)) 'récupère le rang
        resu(nn, j + 1) = resu(nn, j + 1) + tablo(i, j + 1)
        resu(nn, j + 2) = resu(nn, j + 2) + tablo(i, j + 2)
        resu(nn, j + 3) = resu(nn, j + 3) + tablo(i, j + 3)
        resu(nn, j + 4) = resu(nn, j + 4) + tablo(i, j + 4)
        If j = dercol Then 'dernière eone
            For k = dercol + 5 To ncol
                resu(nn, k) = resu(nn, k) + tablo(i, k)
            Next k
        End If
Next i, j
'---restitution---
1 Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution
    If n Then
        .Resize(n, ncol) = resu
        .Resize(n, ncol).Sort .Cells, xlAscending, Header:=xlNo 'tri alphabétique
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
End With
End Sub
Elle se déclenche automatiquement quand on active la feuille.

Elle est très rapide car on utilise des tableaux VBA et le Dictionary.

Le tri alphabétique à la fin permet de déceler certaines anomalies comme :

- 60310100 VAR STOCK CHAUFFAGE et - 60310100 Variation stock chauffage

- 60310200 VAR STOCK PLOMBERIE et - 60310200 Variation stock plomberie

- 60310300 VAR STOCK ELECTRICITE et - 60310300 Var stock électricite

- 60400000 Achats d'études & prest. services et - 60400000 Achats d'études et prestations

- 60610000 Achats fourn. n/stock. eau, énergie et - 60610000 Achats fournitures non stockable

- 60640000 Achats fournitures administatives et - 60640000 Achats fournitures administratives

- etc...

A+
 

Pièces jointes

  • Fichier_a_analyser(1).xlsm
    182.1 KB · Affichages: 4
Vote positif 0 Vote négatif
B

brahim224

XLDnaute Nouveau
brahim224 à dit:
Bonjour à toutes et à tous,

J’ai parcouru le forum à la recherche de macro VBA pour résoudre mon problème et je n’en ai pour l’instant pas trouvé. Je sollicite vivement votre aide.

Mon problème est le suivant :

J’ai un tableau Excel contenant plusieurs colonnes et plusieurs lignes. Les données disponibles sur le fichier sont importées depuis un ERP et c’est des données mensuelles. J’ai donc 4 exercices sur le fichier sachant qu’un exercice fait 12 mois (soit 48 mois au total). L’ERP permet d’exporter seulement 4 mois à la fois, j’ai donc fait autant d’exportation que nécessaire pour avoir tous les 48 mois et les mettre sur la même feuille. Le souci est qu’à chaque exportation, j’ai une colonne qui se répète (la colonne contenant la liste des éléments) et ensuite j’ai certaines lignes qui se sont rajoutés sur certaines exportations tout simplement parce que c’est de nouveaux éléments qui n’existaient pas sur les autres mois.

Ce que je voudrais donc :

C’est d’éliminer les colonnes « éléments » pour ne garder qu’une seule au début, aligner les colonnes des mois ensuite. Si j’ai une ligne xxx qui s’est ajouté sur mars 2021 par exemple et qui n’existait pas sur janvier, mettre 00 dans la cellule de janvier correspondante à cette ligne-là.

Je vous joins le fichier pour vous donner une idée plus précise de ce je voudrais

Merci pour votre aide !

Cordialement,
Cliquez pour agrandir...
Katido à dit:
Bonjour,
Je te propose ce fichier, qui contient une petite macro.
J'ai réutilisé tes données (dans la feuille 1), avec une copie des valeurs pour avoir des valeurs figées et non des valeurs aléatoires ce qui permet de mieux tester.

J'ai crée une feuille "Import" et une feuille "Résultat".

Chaque fois qu'on a des nouvelles données (en principe tous les 4 mois), il faut placer ces données (avec la colonne éléments bien sûr) dans la feuille "Import". Ensuite, on va dans la feuille "Résultat" et on clique sur le bouton "Ajout des données de la feuille 'Import'". Les données doivent s'ajouter automatiquement.

Les nouvelles colonnes avec les mois sont créées automatiquement

Il y a 3 cas de figure pour chaque élément :
- l'élément des nouvelles données existait déjà : les données sont ajoutées dans les nouvelles colonnes
- l'élément des nouvelles données est nouveau et n'existait donc pas : une ligne est créée avec des 0,00 dans les anciennes colonnes. J'ai mis les cellules concernées en rouge pour tester les modifs.
- les nouvelles données ne contiennent pas un élément qui existait auparavant. Les cellules concernées restent vides

J'ai testé avec toutes les données d'octobre 2018 à mars 2022, ça m'a l'air bon.
J'ai tenu compte du fait que certains éléments pouvaient apparaitre 2 fois (par exemple "Coût d'achats marchandises vendues")

On remarque qu'il y a beaucoup de nouveaux éléments à partir d'octobre 2021
Cliquez pour agrandir...
Bonjour Katido,

Tout d'abord, je te remercie pour l'intérêt que t'as accordé à ma demande et pour le temps que t'as consacré à cette macro que je trouve d'ailleurs très élaborée et qui répond à ma problématique.

En executant la macro, ça m'a remonté quelques éléments au mauvais endroit (c'est le cas de la ligne 3 "-60790100 Achat orange p2 logem" et de tous les éléments commençant par un compte et qui, en principe, ne doivent figurer qu'après la ligne "Ecart sur le résultat", ligne 25 colonne A de la feuille des données pour être plus précis). Toutefois, je n'en ai pas beaucoup, du coup je les ai réplacé manuellement et ça le fait.

Quant aux éléments qui apparaissent deux fois, c'est tout à fait normal, le tableau est en deux partie, la première qui contient que les agrégats (ligne 1 à ligne 25 colonne A) et la deuxième partie qui comprend les détails ayant conduits à ces agrégats et on voit bien le nom des mois qui se répètent à partir de la ligne 26.

Merci beaucoup !
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Dans ce fichier (2) les colonnes vides intermédiaires sont supprimées :
VB: 
'---restitution---
1 Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution
    If n Then
        .Resize(n, ncol) = resu
        .Resize(n, ncol).Sort .Cells, xlAscending, Header:=xlNo 'tri alphabétique
    End If
    .Cells(0, 1).Resize(, ncol) = Application.Index(tablo, 1, 0) 'copie les en-têtes
    .Cells(0, 2).Resize(, ncol - 1).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete 'supprime les colonnes vides intermédiaires
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
End With
Columns.AutoFit 'ajuste les largeurs
With UsedRange: End With 'actualise les barres de défilement
Nota : vous parlez de tableau en 2 parties, le tableau des résultats supprime les doublons et regroupe donc les 2 parties en une seule.
 

Pièces jointes

  • Fichier_a_analyser(2).xlsm
    182.5 KB · Affichages: 5
Vote positif 0 Vote négatif
B

brahim224

XLDnaute Nouveau
job75 à dit:
Bonjour brahim224, bienvenue sur XLD, bonjour Katido,

Voyez le fichier joint et cette macro dans le code de la feuille "Résultat" :
VB: 
Private Sub Worksheet_Activate()
Dim tablo, nlig&, ncol%, dercol%, d As Object, j%, i&, x$, n&, resu(), a, nn&, k%
tablo = Sheets("Feuil1").[A1].CurrentRegion 'matrice, plus rapide
nlig = UBound(tablo)
ncol = UBound(tablo, 2)
dercol = 46 'colonne AT, à adapter
'---liste des élémenrs sans doublon---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For j = 1 To dercol Step 5 'colonnes A, F,...AT
    For i = 2 To nlig
        x = tablo(i, j)
        If Not d.exists(x) Then n = n + 1: d(x) = n 'mémorise le rang
Next i, j
If n = 0 Then GoTo 1 'si le tableau est vide
'---tableau des résultats---
ReDim resu(1 To n, 1 To ncol)
a = d.keys
For i = 1 To UBound(resu)
    resu(i, 1) = a(i - 1)
Next i
For j = 1 To dercol Step 5 'colonnes A, F,...AT
    For i = 2 To nlig
        nn = d(tablo(i, j)) 'récupère le rang
        resu(nn, j + 1) = resu(nn, j + 1) + tablo(i, j + 1)
        resu(nn, j + 2) = resu(nn, j + 2) + tablo(i, j + 2)
        resu(nn, j + 3) = resu(nn, j + 3) + tablo(i, j + 3)
        resu(nn, j + 4) = resu(nn, j + 4) + tablo(i, j + 4)
        If j = dercol Then 'dernière eone
            For k = dercol + 5 To ncol
                resu(nn, k) = resu(nn, k) + tablo(i, k)
            Next k
        End If
Next i, j
'---restitution---
1 Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution
    If n Then
        .Resize(n, ncol) = resu
        .Resize(n, ncol).Sort .Cells, xlAscending, Header:=xlNo 'tri alphabétique
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
End With
End Sub
Elle se déclenche automatiquement quand on active la feuille.

Elle est très rapide car on utilise des tableaux VBA et le Dictionary.

Le tri alphabétique à la fin permet de déceler certaines anomalies comme :

- 60310100 VAR STOCK CHAUFFAGE et - 60310100 Variation stock chauffage

- 60310200 VAR STOCK PLOMBERIE et - 60310200 Variation stock plomberie

- 60310300 VAR STOCK ELECTRICITE et - 60310300 Var stock électricite

- 60400000 Achats d'études & prest. services et - 60400000 Achats d'études et prestations

- 60610000 Achats fourn. n/stock. eau, énergie et - 60610000 Achats fournitures non stockable

- 60640000 Achats fournitures administatives et - 60640000 Achats fournitures administratives

- etc...

A+
Cliquez pour agrandir...
Bonjour Job75,

Tout d'abord merci pour ta réponse. Je n'arrive pas a exécuté ta macro, quand je clique sur la feuille de résultat, j'ai le message suivant qui s'affiche : "Erreur d'exécution 429 : Un composant ActiveX ne peut pas créer d'objet".

Aussi t'as raison pour les anomalies, après je ne veux pas qu'il y'ai de tri alphabétique. Les données sont disposées selon une logique prédéfinie qui doit rester après le retraitement.
Donc le mieux serait de caser les anomalies détectées en bas du tableau, ensuite je les replacerai manuellement après (doit pas y en avoir plus beaucoup et je sais où doit se placer chaque ligne).

Merci,
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Sur MAC il n'y a pas de Dictionary mais on peut utiliser 2 collections pour éliminer les doublons :
VB: 
Private Sub Worksheet_Activate()
Dim tablo, nlig&, ncol%, dercol%, c As New Collection, cc As New Collection, j%, i&, n&, resu(), nn&, k%
tablo = Sheets("Feuil1").[A1].CurrentRegion 'matrice, plus rapide
nlig = UBound(tablo)
ncol = UBound(tablo, 2)
dercol = 46 'colonne AT, à adapter
'---liste des élémenrs sans doublon---
On Error Resume Next
For j = 1 To dercol Step 5 'colonnes A, F,...AT
    For i = 2 To nlig
        c.Add c.Count + 1, LCase(tablo(i, j)) 'mémorise le rang
        cc.Add tablo(i, j), CStr(c.Count) 'récupère la clé avec la casse d'origine
Next i, j
On Error GoTo 0
n = c.Count
If n = 0 Then GoTo 1 'si le tableau est vide
'---tableau des résultats---
ReDim resu(1 To n, 1 To ncol)
For i = 1 To n
    resu(i, 1) = cc(CStr(i))
Next i
For j = 1 To dercol Step 5 'colonnes A, F,...AT
    For i = 2 To nlig
        nn = c(LCase(tablo(i, j))) 'récupère le rang
        resu(nn, j + 1) = resu(nn, j + 1) + tablo(i, j + 1)
        resu(nn, j + 2) = resu(nn, j + 2) + tablo(i, j + 2)
        resu(nn, j + 3) = resu(nn, j + 3) + tablo(i, j + 3)
        resu(nn, j + 4) = resu(nn, j + 4) + tablo(i, j + 4)
        If j = dercol Then 'dernière zone
            For k = dercol + 5 To ncol
                resu(nn, k) = resu(nn, k) + tablo(i, k)
            Next k
        End If
Next i, j
'---restitution---
1 Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution
    If n Then
        .Resize(n, ncol) = resu
        '.Resize(n, ncol).Sort .Cells, xlAscending, Header:=xlNo 'tri alphabétique facultatif
    End If
    .Cells(0, 1).Resize(, ncol) = Application.Index(tablo, 1, 0) 'copie les en-têtes
    .Cells(0, 2).Resize(, ncol - 1).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete 'supprime les colonnes vides intermédiaires
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
End With
Columns.AutoFit 'ajuste les largeurs
With UsedRange: End With 'actualise les barres de défilement
End Sub
J'ai neutralisé le tri alphabétique mais vous pouvez le réactiver quand vous voulez.

Testez ce fichier (3), c'est un peu moins rapide qu'avec le Dictionary.
 

Pièces jointes

  • Fichier_a_analyser(3).xlsm
    183 KB · Affichages: 1
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour brahim224, le forum,

Dans les fichiers précédents le balayage se faisait par colonnes puis par lignes.

Dans ce fichier (3 bis) il se fait par lignes puis par colonnes.

Le classement des textes est meilleur : 3 éléments seulement sont mal placés.

A+
 

Pièces jointes

  • Fichier_a_analyser(3 bis).xlsm
    183 KB · Affichages: 1
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Une tentative dans ce fichier (4) pour faire un classement plus cohérent avec cette macro :
VB: 
Sub Classement(r As Range)
Dim tablo, i&, x$
r(1).EntireColumn.Insert 'insère une colonne auxiliaire
tablo = r.Columns(0).Resize(, 2) 'matrice, plus rapide
For i = 1 To UBound(tablo)
    x = UCase(Trim(tablo(i, 2)))
    If Left(x, 1) = "-" Then
        tablo(i, 1) = 7
    ElseIf x = "" Then
        tablo(i, 1) = 6
    ElseIf x Like "ECART*" Then
        tablo(i, 1) = 5
    ElseIf x Like "R?SULTAT*EXERCICE" Then
        tablo(i, 1) = 4
    ElseIf x Like "*EXCEPTION*" Then
        tablo(i, 1) = 3
    ElseIf x Like "*IMPÔTS*" Then
        tablo(i, 1) = 2
    Else
        tablo(i, 1) = 1
    End If
Next i
r.Columns(0) = tablo 'remplit la colonne auxiliaire
Union(r.Columns(0), r).Sort r.Columns(0), xlAscending, Header:=xlNo 'tri sur la colonne auxiliaire
r.Columns(0).EntireColumn.Delete 'supprime la colonne auxiliaire
End Sub
 

Pièces jointes

  • Fichier_a_analyser(4).xlsm
    185.6 KB · Affichages: 3
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Microsoft 365 Case à cocher Excel sur tablette
Réponses
2
Affichages
234
Mat31
M
7
  • Question
Microsoft 365 Tableau de Géolocalisation de vidéos de drone avec lien vers Google Earth
2
Réponses
15
Affichages
597
sylvanu
sylvanu
M
  • Question
Microsoft 365 Formule pour chercher une valeur dans une colonne
Réponses
5
Affichages
513
Efgé
Efgé
C
  • Question
XL 2016 Excel Macro permettant de masquer une ligne lorsque les cellules de 2 colonnes contigües sont vides
Réponses
11
Affichages
250
chris63
C
J
  • Question
XL 2016 Date
Réponses
6
Affichages
535
chris
chris
M
  • Question
XL 2019 Consolidation des comptes de salariés mois par mois
Réponses
4
Affichages
282
sylvanu
sylvanu
G
  • Résolu(e)
XL 2021 Tournoi 16 équipes en 2 poules de 8
2
Réponses
16
Affichages
877
gouge
G
J
  • Question
XL 2016 Création planning annuel
Réponses
1
Affichages
653
Sheldor
S
O
  • Question
XL 2019 Vba excel
Réponses
4
Affichages
235
olivier1984
O
A
  • Question
XL pour MAC Office MAC & Graphiques
Réponses
2
Affichages
335
crocrocro
C

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 41 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
314 771
Messages
2 112 768
Membres
111 653
dernier inscrit
Vanie0082