Probleme de format de tableau

[Igor]

Bonjour le Forum


Je reçois tous les mois d'un fournisseur un tableau assez conséquent (plusieurs centaines de lignes et entre 100 et 120 colonnes)

Si les 26 premières colonnes du tableau sont identiques tous les mois, les autres changent de place.... la colonne AG de février (CA ENT) devient AC en Avril, la colonne DK (ACTE SAV) se retrouve en CW, etc.

Pour le moment je coupe/colle tous les mois le nouveau fichier afin de faire matcher les colonnes.


Je suis à la recherche d'automatisation (via une macro ou autre) afin de pouvoir mettre mon tableau en forme bien plus rapidement.

Je mets en pièce jointe les tableaux de Février et d'Avril 2014, anonymisés comme il se doit. En raison de la limitation de la taille j'ai du supprimer pas mal de lignes sur chaque fichier. De ce fait certaines colonnes n'ont pas de données: dans l'original toutes les colonnes ont au moins 1 donnée (et souvent une seul).


Merci d'avance pour vos idées.


Igor

 

[Dugenou]

Re : Probleme de format de tableau

Bonjour,
avec une feuille data où vous collez vos données du mois (titres compris) et une feuille modèle où vous indiquez en ligne 1 tous les titres de colonne possibles tous mois confondus (respect exact des titres)
en a2 du modèle : =SI(ESTVIDE(data!A2);"";data!A2) recopier jusque colonne Z et jusqu'en bas
en AA du modèle : =DECALER(data!$Z2;;EQUIV(AA$1;data!$AA$1:$DO$1;0)) si DO est la dernière colonne possible puis recopier à droite et en bas

enfin une feuille extraction qui ne récupére dans modèle que les colonnes dont vous avez besoin par des liens direct puisque en feuille modèle vos colonnes ne changeront pas

voir essai succinct en pj

 

[pierrejean]

Re : Probleme de format de tableau

Bonjour igor

Salut Dugenou

Un essai en vba
NB: Il doit y avoir respect intégral des têtes de colonne et le (ou les) fichiers doivent être ouverts la succession des colonnes peut etre modifiée dans la feuil1

 

[Igor]

Re : Probleme de format de tableau

Dugenou,


De nouveaux intitulées de colonnes arrivent (presque) tous les mois, d'autres ne réapparaîtront pas (ce sont des offres commerciales en téléphonies). Pense tu que cela soit gérable avec ta solution?

Merci pour ton intérêt.


Igor

 

[Dugenou]

Re : Probleme de format de tableau

il faut simplement que les intitulés qui te sont nécessaires soient présents
il faudra chaque mois vérifier que dans ton modèle la formule decaler couvre bien toutes les colonnes de tes data

 

[Igor]

Re : Probleme de format de tableau

Re merci Dugenou.

 

[Igor]

Re : Probleme de format de tableau

Pierrejean

Je test cette solution et reviens vers toi en début de semaine.


Merci

Igor

 

[pierrejean]

Re : Probleme de format de tableau

Re

Voila une version qui devrait récupérer les colonnes ajoutées
A bien tester !!! (les tests ce n'est pas mon fort )

 

[PMO2]

Re : Probleme de format de tableau

Bonjour,

J'ai compris qu'il faut réorganiser la structure des colonnes d'un mois à l'autre pour qu'elles se correspondent.
Qu'on puisse copier les données les unes en dessous des autres OU les visualiser avec un affichage côte à côte.

Si c'est bien de cela qu'il s'agit voici une piste en VBA qui réorganise les colonnes en les déplaçant.

1) Copiez les données de chaque mois dans les 2 premières feuilles (dans mon exemple mois1 et mois2).
Le traitement s'opère sur ces 2 feuilles d'index 1 et 2 et pas sur les autres. Il faut donc respecter cet ordre.
2) Copiez le code suivant dans un module Standard

'/// Variable portée Module ///
Dim T()
'//////////////////////////////

Sub aa()
Dim S As Worksheet
Dim R As Range
Dim var1
Dim var2
Dim Ret
Dim i&
Dim j&
Dim cpt&
'---
ReDim T(1 To 4, 1 To 1)
'--- Les feuilles index 1 et index 2 vont être traitées ---
Ret = MsgBox("Les 2 feuilles qui vont être traitées" & vbCrLf & Sheets(1).Name & "   " & Sheets(2).Name, vbOKCancel)
If Ret = vbCancel Then Exit Sub
'--- Récupération des données de chaque feuille dans un Variant ---
Set S = Sheets(1)
Set R = S.Range(S.Cells(1, 1), S.Cells(1, S.UsedRange.Columns.Count))
var1 = R
Set S = Sheets(2)
Set R = S.Range(S.Cells(1, 1), S.Cells(1, S.UsedRange.Columns.Count))
var2 = R
'--- Balayage 1 : En-têtes communs aux 2 feuilles ---
For i& = 1 To UBound(var1, 2)
  For j& = 1 To UBound(var2, 2)
    If var1(1, i&) = var2(1, j&) Then
      cpt& = cpt& + 1
      ReDim Preserve T(1 To 4, 1 To cpt&)
      T(1, cpt&) = var1(1, i&)  ' L'en-tête
      T(2, cpt&) = i&           ' N° actuel de colonne de la feuille 1
      T(3, cpt&) = j&           ' N° actuel de colonne de la feuille 2
      T(4, cpt&) = cpt&         ' Attribue un nouveau N° de colonne
      var1(1, i&) = ""          ' On efface pour balayages ultérieurs
      var2(1, j&) = ""          ' On efface pour balayages ultérieurs
      Exit For
    End If
  Next j&
Next i&
'--- Balayage 2 : En-têtes particuliers de la feuille 1 ---
For i& = 1 To UBound(var1, 2)
  If var1(1, i&) <> "" Then
    cpt& = cpt& + 1
    ReDim Preserve T(1 To 4, 1 To cpt&)
    T(1, cpt&) = var1(1, i&)    ' L'en-tête
    T(2, cpt&) = i&             ' N° actuel de colonne de la feuille 1
    T(4, cpt&) = cpt&           ' Attribue un nouveau N° de colonne
  End If
Next i&
'--- Balayage 3 : En-têtes particuliers de la feuille 2 ---
For i& = 1 To UBound(var2, 2)
  If var2(1, i&) <> "" Then
    cpt& = cpt& + 1
    ReDim Preserve T(1 To 4, 1 To cpt&)
    T(1, cpt&) = var2(1, i&)    ' L'en-tête
    T(3, cpt&) = i&             ' N° actuel de colonne de la feuille 2
    T(4, cpt&) = cpt&           ' Attribue un nouveau N° de colonne
  End If
Next i&
'--- Affichage d'un rapport (Log) ---
Set S = Sheets.Add(after:=Sheets(Sheets.Count))
Range(S.Cells(2, 1), S.Cells(cpt& + 1, 4)) = Application.WorksheetFunction.Transpose(T)
Set R = Range(S.Cells(1, 1), S.Cells(1, 4))
R = Array("TITRE", "Ancien N° colonne Feuille1", "Ancien N° colonne Feuille2", "Nouveau N° de colonne")
R.Font.Bold = True
R.HorizontalAlignment = xlCenter
S.Columns.AutoFit
'--- Réorganisation des colonnes ---
Call ReorganisationColonnes(Sheets(1), 2) 'La feuille 1
Call ReorganisationColonnes(Sheets(2), 3) 'La feuille 2
End Sub

Sub ReorganisationColonnes(S As Worksheet, Rang As Long)
'########################################################
'### Evite d'écraser les colonnes existantes, déplace ###
'### à destination du nouveau N° de colonne + 1000    ###
Const INCREMENT_DEPLACEMENT As Long = 1000
'########################################################
Dim i&
Dim B$
'---
Application.ScreenUpdating = False
'--- Déplcement des colonnes ---
For i& = 1 To UBound(T, 2)
  If T(Rang, i&) <> "" Then
    S.Columns(T(Rang, i&)).Cut Destination:=S.Columns(T(4, i&) + INCREMENT_DEPLACEMENT)
  End If
Next i&
'--- Supprime les 1000 prèmières colonnes vides ---
B$ = Columns(INCREMENT_DEPLACEMENT).Address(False, False)
B$ = "A:" & Mid(B$, 1, InStr(1, B$, ":") - 1)
S.Columns(B$).Delete Shift:=xlToLeft
'---
Application.ScreenUpdating = True
End Sub

Lancez la Sub aa
Une feuille de rapport (Log) apparaît. Le traitement affecte directement les 2 premières feuilles en réorganisant l'ordre des colonnes.
Il faut un peu attendre car le traitement du déplacement des colonnes n'a pas été optimisé mais c'est humainement acceptable (quelques secondes).

 

[Igor]

Re : Probleme de format de tableau

Merci a tous pour vos solutions.

Je les test et je reviens vers vous pour les résultats cette semaine.


Igor