Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Suppression de colonnes

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

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

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

brahim224

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

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

brahim224

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

job75

XLDnaute Barbatruc
Vous voulez dire que mes fichiers des post #3 et #5 ne fonctionnent pas chez vous ?

Il suffit pourtant de cliquer sur l'onglet "Résultat", sans utiliser de bouton.

je ne peux donc plus rien faire pour vous.
 

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

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

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:

Discussions similaires

Réponses
6
Affichages
535
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…