Déplacer des colonnes dans un ordre en vba

[bloublou]

Bonsoir à tous,

Je voudrais déplacer les colonnes de la feuille 1 dans l'ordre de la feuille 2 en vba ? 😕

Pouvez-vous m'aider ?

Bonne nuit

BlouBlou

 

[DoubleZero]

Re : Déplacer des colonnes dans un ordre en vba

Bonjour, bloublou, le Forum,

Un essai en pièce jointe.

A bientôt 🙂

 

[job75]

Re : Déplacer des colonnes dans un ordre en vba

Bonjour bloublou, 00 🙂

Ce problème de classement de colonnes est intéressant, je mets un Like au post #1.

Chère ânesse j'espère que tu ne m'en voudras pas de squatter ton fichier.

La macro :

Sub ClasserColonnes()
'Feuil1 et Feuil2 sont les CodeNames des feuilles
Dim col%, P1 As Range, P2 As Range, i%, n
Application.ScreenUpdating = False
col = Feuil2.Cells(1, Feuil2.Columns.Count).End(xlToLeft).Column
Set P1 = Feuil1.Columns(1).Resize(, col)
Set P2 = Feuil2.Rows(1)
1 For i = 1 To col
  If P1.Cells(1, i) <> "" Then
    n = Application.Match(P1.Cells(1, i), P2, 0)
    If IsError(n) Then MsgBox "Revoyez les titres en Feuil2 !": Exit Sub
    If i <> n Then
      P1.Columns(i).Cut
      P1.Columns(n + 1).Insert
      GoTo 1
    End If
  End If
Next
Application.Goto P1.Cells(1)
End Sub

A+

 

[DoubleZero]

Re : Déplacer des colonnes dans un ordre en vba

Re-bonjour, bonjour, job75 😀,

... j'espère que tu ne m'en voudras pas de squatter ton fichier...

Moi ? T'en vouloir ? En ai-je l'air 😡 ?

​

Bravo, job75 et...

... A bientôt 😀😀

 

[job75]

Re : Déplacer des colonnes dans un ordre en vba

Re,

Il vaut mieux utiliser cette macro :

Sub ClasserColonnes()
'Feuil1 et Feuil2 sont les CodeNames des feuilles
Dim col1%, col%, P1 As Range, P2 As Range, i%, n
Application.ScreenUpdating = False
col1 = Feuil1.Cells(1, Feuil1.Columns.Count).End(xlToLeft).Column
col = Feuil2.Cells(1, Feuil2.Columns.Count).End(xlToLeft).Column
col = Application.Max(col1, col)
Set P1 = Feuil1.Columns(1).Resize(, col)
Set P2 = Feuil2.Rows(1)
1 For i = 1 To col
  If P1.Cells(1, i) <> "" Then
    n = Application.Match(P1.Cells(1, i), P2, 0)
    If IsError(n) Then MsgBox "Revoyez les titres en Feuil2 !": Exit Sub
    If i <> n Then
      P1.Columns(i).Cut
      P1.Columns(n - (i < n)).Insert 'True se convertit en -1
      GoTo 1
    End If
  End If
Next
Application.Goto P1.Parent.[A1]
End Sub

Elle permet de traiter le cas où le n° de la dernière colonne (col1) en Feuil1 est supérieur à cellui de Feuil2.

Fichier (2), mais testez aussi cette macro sur le fichier (1).

A+

 

[job75]

Re : Déplacer des colonnes dans un ordre en vba

Re,

La variable P1 compliquait inutilement la compréhension, ceci est plus simple :

Sub ClasserColonnes()
'Feuil1 et Feuil2 sont les CodeNames des feuilles
Dim F As Worksheet, col1%, col%, P As Range, i%, n
Application.ScreenUpdating = False
Set F = Feuil1
col1 = F.Cells(1, F.Columns.Count).End(xlToLeft).Column
col = Feuil2.Cells(1, Feuil2.Columns.Count).End(xlToLeft).Column
col = Application.Max(col1, col)
Set P = Feuil2.Rows(1).Resize(, col)
1  For i = 1 To col
  If F.Cells(1, i) <> "" Then
    n = Application.Match(F.Cells(1, i), P, 0)
    If IsError(n) Then MsgBox "Revoyez les titres en Feuil2 !": Exit Sub
    If i <> n Then
      F.Columns(i).Cut
      F.Columns(n - (i < n)).Insert 'True se convertit en -1
      GoTo 1
    End If
  End If
Next
Application.Goto F.[A1]
End Sub

Fichier (3).

A+

 

[bloublou]

Re : Déplacer des colonnes dans un ordre en vba

Bonsoir le forum, 00, job75,

Merci pour vos 2 solutions ca marche nickel 🙂
la macro serait équivalente si c'était sur la même feuille que l'on déplacerait les colonnes ?

Merci

BlouBlou

 

[job75]

Re : Déplacer des colonnes dans un ordre en vba

Bonjour bloublou, 00, le forum,

la macro serait équivalente si c'était sur la même feuille que l'on déplacerait les colonnes ?

Justement les solutions précédentes déplacent les colonnes uniquement sur Feuil1.

Si l'on utilise Feuil2 c'est bien plus simple :

Sub ClasserColonnes()
Dim F1 As Worksheet, F2 As Worksheet, P As Range, i%, n
Set F1 = Feuil1: Set F2 = Feuil2 'CodeNames
Set P = Feuil2.Rows(1)
For i = 1 To F1.Cells(1, F1.Columns.Count).End(xlToLeft).Column
  If F1.Cells(1, i) <> "" Then
    n = Application.Match(F1.Cells(1, i), P, 0)
    If IsError(n) Then MsgBox "Revoyez les titres en Feuil2 !": Exit For
    F1.Columns(i).Copy F2.Cells(1, n)
  End If
Next
If IsError(n) Then F2.Rows("2:" & F2.Rows.Count).Delete
Application.Goto F2.[A1]
End Sub

Le copier/coller d'une feuille à l'autre suffit.

Fichiers (4) et (4 bis).

A+

 

[bloublou]

Re : Déplacer des colonnes dans un ordre en vba

Bonjour le forum, job 75, 00,

Je vais regarder tout ca a tete reposée 🙂

Merci en tout cas pour votre aide.

Bon dimanche

BlouBlou

 

[job75]

Re : Déplacer des colonnes dans un ordre en vba

Re,

Je reviens sur le déplacement des colonnes en Feuil1 en exploitant les excellentes idées de DoubleZero :

- insertion d'une ligne auxiliaire

- tri de gauche à droite :

Sub ClasserColonnes()
Dim F1 As Worksheet, F2 As Worksheet, col%
Dim P As Range, c As Range, r As Range
Application.ScreenUpdating = False
Set F1 = Feuil1: Set F2 = Feuil2
col = F2.Cells(1, F2.Columns.Count).End(xlToLeft).Column
Set P = F2.[A1].Resize(, col + 1)
F1.[1:1].Insert 'ligne auxiliaire
For Each c In F1.[A2].Resize(, col)
  Set r = P.Find(c, P(col + 1), xlValues, xlWhole)
  If r Is Nothing Then MsgBox "Revoyez les titres en Feuil2 !": Exit For
  c(0) = r.Column
  If r = "" Then r.EntireColumn.Hidden = True 'masque la colonne
Next
If Not r Is Nothing Then F1.Columns(1).Resize(, col) _
  .Sort F1.[A1], xlAscending, Header:=xlNo, Orientation:=xlLeftToRight 'tri
F1.[1:1].Delete 'suppression de la ligne auxiliaire
F2.Columns(1).Resize(, col).Hidden = False 'affichage des colonnes
Application.Goto F1.[A1]
End Sub

Avec le tri l'exécution est bien plus rapide.

Evidemment il y a des astuces (masquage des colonnes par exemple) pas faciles à comprendre 😎

Fichier (5).

A+

 

[pierrejean]

Re : Déplacer des colonnes dans un ordre en vba

Bonjour bloublou DoubleZero Gerard

Un essai avec un code peut être un peu plus facile à comprendre a défaut d’être aussi rapide

Sub essai()
Dim dercol As Integer, derlin As Integer, tablo
Dim n As Integer, m As Integer, col As Integer, y As Range
dercol = Sheets("Feuil1").Cells(1, Columns.Count).End(xlToLeft).Column
derlin = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
tablo = Sheets("Feuil1").Range(Cells(1, 1).Address & ":" & Cells(derlin, dercol).Address)
Sheets("Feuil1").Range(Cells(1, 1).Address & ":" & Cells(derlin, dercol).Address).ClearContents
Sheets("Feuil2").Rows(1).Copy Destination:=Sheets("Feuil1").Range("A1")
Application.ScreenUpdating = False
For n = LBound(tablo, 2) To UBound(tablo, 2)
  Set y = Sheets("Feuil1").Rows(1).Find(tablo(LBound(tablo, 1), n), LookIn:=xlValues, lookat:=xlWhole)
  col = y.Column
  For m = LBound(tablo, 1) + 1 To UBound(tablo, 1)
    Sheets("Feuil1").Cells(m, col) = tablo(m, n)
  Next
Next
Application.ScreenUpdating = False
End Sub

 

[job75]

Re : Déplacer des colonnes dans un ordre en vba

Bonjour pierrejean 🙂

D'accord mais la durée d'exécution peut avoir son importance.

Vois les 2 "petits" fichiers joints avec 10006 lignes.

Mon fichier utilise la version (5) de mon post #10.

A+

 

[pierrejean]

Re : Déplacer des colonnes dans un ordre en vba

Re

OK job75

J'avais bien specifié :

a défaut d’être aussi rapide

 

[bloublou]

Re : Déplacer des colonnes dans un ordre en vba

Bonsoir le forum, 00, job75, PierreJean,

Merci pour tous ces codes et de s'être pencher sur mon pb 😛

Le code de job 75 est chaud à comprendre mais je vais essayer 🙂 🙂

Bonne soirée

BlouBlou

 

[job75]

Re : Déplacer des colonnes dans un ordre en vba

Bonjour bloublou, Pierre, le forum,

Ah j'avais oublié le cas où la dernière colonne en Feuil1 est supérieure à celle en Feuil2.

Utilisez donc cette macro qui fonctionne dans tous les cas :

Sub ClasserColonnes()
Dim F1 As Worksheet, F2 As Worksheet, col1%, col%, c As Range, r As Range
Application.ScreenUpdating = False
Set F1 = Feuil1: Set F2 = Feuil2 'CodeNames des feuilles
col1 = F1.Cells(1, F1.Columns.Count).End(xlToLeft).Column
col = F2.Cells(1, F2.Columns.Count).End(xlToLeft).Column
col = Application.Max(col1, col)
F1.[1:1].Insert 'ligne auxiliaire
For Each c In F1.[A2].Resize(, col)
  Set r = F2.[A1].Resize(, col).Find(c, , xlValues, xlWhole)
  If r Is Nothing Then MsgBox "Revoyez les titres en Feuil2 !": Exit For
  c(0) = r.Column
  If r = "" Then r.EntireColumn.Hidden = True 'masque la colonne
Next
If Not r Is Nothing Then F1.Columns(1).Resize(, col) _
  .Sort F1.[A1], xlAscending, Header:=xlNo, Orientation:=xlLeftToRight 'tri
F1.[1:1].Delete 'suppression de la ligne auxiliaire
F2.Columns(1).Resize(, col).Hidden = False 'affichage des colonnes
Application.Goto F1.[A1]
End Sub

Fichier (6).

A+