Macro Excel - Faire appel à une colonne spécifique

[icecrazy]

Bonjour, je viens vers vous pour 2 questions connes...

1) J'ai un fichier avec 4 colonnes ex : nom prénom adresse téléphone

Je souhaite intervertir les colonnes "prénom" et "nom"

A la base j'utilise le code suivant (qui fonctionne très bien )

Columns("A:A").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight

Il peut arriver que sur certains tableau, les colonnes sont dans le bon ordre et comme j'ai environ une dizaine de base à gérer de ce style, je voudrais trouver un code prenant non pas en compte colonne A colonne B etc etc mais un nom spécifique (ici "nom", "prénom"....) contenu sur la ligne A).

un truc de ce style :

Selectionne la colonne intitulé "nom"
L'insérer en colonne A


2) sur mes mêmes colonnes, je dois changer les titres afin de les communiquer à des clients (anglais)

ex : la colonne qui a comme titre "Nom" (peu importe ou elle se trouve sur la ligne A...) doit se renommer "Nom client"



Voila, je vous remercie par avance

[Banzai64]

Bonjour

Faute de support je l'ai interprété à ma manière

Code: Tout sélectionner

Option Explicit

Sub Deplace()
Dim Cel As Range

  Set Cel = Rows(1).Find(what:="Nom", LookIn:=xlValues, lookat:=xlWhole)
  If Not Cel Is Nothing Then
    If Cel.Column > 1 Then
      Columns(Cel.Column).Cut
      Columns(1).Insert
    End If
    Range("A1") = "Nouveau Nom"
  Else
    MsgBox "Colonne Nom : Non trouvée"
  End If
End Sub
 

[icecrazy]

Merci pour ton début de code mais dure à appliquer a mon code (je suis novice...)

Pour le moment, je prend des blocs a droite à gauche pour arriver a mes fins.

Ma console de départ est la PJ "pilotage rapport des ventes .jpg"

La macro mise en forme me sert à aller ouvrir un fichier dans un chemin spécifique, appliquer les formules a tous les fichiers et tous les onglets s'y trouvant (fichier MEF1, MEF2...). En vrai conditions, j'ai 6 ou 7 fichiers de 6 onglets a gérer.

Private Sub MEF_Click()

Dim strFichier, strSheet As String
Dim subRepertoire, chemin As String
Dim fichier(1 To 30) As String
Dim compteur As Integer
Dim FC As String
Dim S As Worksheet
Dim wb As String

compteur = 1
Dim i, j, k, n, t, f As Integer

'répertoire où se trouve le fichier (en B3 sur notre fichier)
strRepertoire = Cells(3, 2)
k = Cells(4, 3).Value + 5 'elle se trouve en C4, prendre la valeur +5

' le ligne où se trouve le dernier fichier
For i = 6 To k
strFichier = Cells(i, 3).Value

' compter le nombre de SHEETS dans le fichier
subRepertoire = strRepertoire & "\" & strFichier
Workbooks.Open Filename:=subRepertoire
t = Worksheets.Count
wb = ActiveWorkbook.Name
For Each S In Worksheets
S.Activate
If Left(S.Name, 1) = "R" Then
GoTo suivant
Else

' Supprimer tous les filtre (ici j'ai du mal, certain fichiers seront filtré, d'autres pas. En gros je souhaite tout défiltrer)
Selection.AutoFilter

' Sélectionner tout le fichier, le copier, le coller spécial en valeur et format
S.Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False


' Sélectionner la colonne A et la supprimer
S.Columns("A:A").Select
Selection.Delete Shift:=xlToLeft

' Sélectionner la colonne A (anciennement B)et la supprimer
S.Columns("A:A").Select
Selection.Delete Shift:=xlToLeft

' Sélectionner "Start date" et le mettre après "policy number"
S.Columns("M:M").Select
Selection.Cut
S.Columns("B:B").Select
Selection.Insert Shift:=xlToRight

' Sélectionner "Cover type reel" et le met à la suite
S.Columns("Z:Z").Select
Selection.Cut
S.Columns("C:C").Select
Selection.Insert Shift:=xlToRight

' Sélectionner "Date début finale" et "date fin finale" et le met à la suite
S.Columns("AD:AE").Select
Selection.Cut
S.Columns("D:D").Select
Selection.Insert Shift:=xlToRight

' Sélectionner "Cancel date" et le met à la suite
S.Columns("S:S").Select
Selection.Cut
S.Columns("F:F").Select
Selection.Insert Shift:=xlToRight

' Sélectionner "Totbill Inc Disc" et "IPT" et "UW" et le met à la suite
S.Columns("N:P").Select
Selection.Cut
S.Columns("G:G").Select
Selection.Insert Shift:=xlToRight

' Sélectionner "Fréquence de paiement" et le met à la suite
S.Columns("Z:Z").Select
Selection.Cut
S.Columns("J:J").Select
Selection.Insert Shift:=xlToRight

' Sélectionner les colonnes ne servant pas et les supprimer
S.Columns("K:BB").Select
Selection.Delete Shift:=xlToLeft

' fin

' la valeur 4 ici c'est à dire la colonne

n = ActiveSheet.Range("A1").End(xlDown).Row
If n = 65536 Then
GoTo suivant
' il existe pas la valeur neg
Else

End If

End If
suivant:
Windows(wb).Activate
Next S

ActiveWorkbook.Save
Windows(wb).Close

Next i

MsgBox ("Travail effectué")

End Sub


j'en suis à la version expérimentale donc certaines lignes sont a retirer j'ai repiqué des bout de code...


Le travail ou je bloque se trouve en gras :

1) que la macro désélectionne bien tous les filtres

2) Que les déplacements de colonnes s'effectuent sur le nom des colonnes et non sur les colonnes A etc etc

3) Pas encore fait : Une fois le fichier mis en forme, renommer le nom d'une colonne par un autre nom

Merci pour os réponses

[Banzai64]

Bonjour

J'ai bien envisagé une nouvelle macro pour faire ce que tu veux
Mais je l'ai testé sur rien

Donc je te la livre telle quelle (sans garantie aucune)

Le mieux serait que tu joignes ton fichier principal et 1 ou 2 fichiers à traiter (tous anonymisés bien sur)

Code: Tout sélectionner

Option Explicit

Private Sub MEF_Click()
Dim Ws As Worksheet
Dim Cel As Range
Dim AncienNomColonne
Dim NouveauNomColonne
Dim I As Integer
Dim K As Integer

  AncienNomColonne = Array("Fréquence de paiement", "UW", "IPT", "Totbill Inc Disc", _
                           "Cancel date", "date fin finale", "Date début finale", "Cover type reel", "Start Date")
  NouveauNomColonne = Array("Fréquence de paiement", "UW", "IPT", "Totbill Inc Disc", _
                           "Cancel date", "date fin finale", "Date début finale", "Cover type reel", "Start Date")

  ' répertoire où se trouve le fichier (en B3 sur notre fichier)
 ' Cells(3, 2).value : contient strRepertoire
 ' Cells(I, 3).Value : contient strFichier
 
  For I = 6 To Cells(4, 3).Value + 5
    Workbooks.Open Filename:=Cells(3, 2) & "\" & Cells(I, 3).Value
    For Each Ws In Worksheets
      If Left(Ws.Name, 1) <> "R" Then         ' On inverse la condition : On traite si le nom ne commence pas par R
       With Ws                               ' On travaille avec la feuille
         On Error Resume Next                ' Si pas de filtre il n'y aura pas de plantage
         ' Supprimer tous les filtres
         .ShowAllData
          On Error GoTo 0
         
          .Cells.Copy
          .Cells.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
                              Operation:=xlNone, SkipBlanks:=False, Transpose:=False
         
          ' Suppression des colonnes A et B
         .Columns("A:B").Delete
         
       
          ' En prenant la liste des colonnes à l'envers on cherche la colonne et on l'insère toujours en colonne B
         For K = 1 To UBound(AncienNomColonne)
            Set Cel = .Rows(1).Find(what:=AncienNomColonne(K), LookIn:=xlValues, lookat:=xlWhole)
            If Not Cel Is Nothing Then
              .Columns(Cel.Column).Cut
            End If
            ' Si la colonne est pas trouvée elle sera copiée sinon une colonne sera insérée
           .Columns(2).Insert
            .Range("B1") = NouveauNomColonne(K)             ' Si l'on veut changer
         Next K
       
          ' On efface le reste de la page
         .Columns("K:BB").Delete
       
'' ***********  Quelle utilité de ce code ? *************
'          ' la valeur 4 ici c'est à dire la colonne
'
'          n = ActiveSheet.Range("A1").End(xlDown).Row
'          If n = 65536 Then
'            GoTo suivant
'            ' il existe pas la valeur neg
'          End If
'' ********************************************************
       End With
      End If
suivant:
    Next Ws
 
    With ActiveWorkbook
      .Save
      .Close
    End With
  Next I
 
  MsgBox ("Travail effectué")
End Sub
 

[icecrazy]

Les codes que tu as encadré en vert ne servent à rien, cela fait partie des bouts de code que j'ai "adapté" et qui reste a enlever (pris par le temps et la requête tournant, j'ai laissé comme ca)


Tous les fichiers se trouvent en PJ

A la base, j’ai mes données brutes que j’ai traité (fichiers MEF1 et MEF2)

1) J’ouvre le fichier « Macro rapport des ventes » pour lancer la requête « mise en forme » (sub MEF)

En B3 : chemin ou sont stockées les fichiers à traiter
En C6, D6…. : nom des fichiers à traiter

Seul les colonnes en jaune me servent

La macro fait tourné environ 1 500 000 lignes dans 6/7 fichiers de 3/4 onglets chacun (d'ou l'automatisation des copier coller lol car il y en a pour 2/3 de taff)



2) Une fois la macro terminée, j’obtiens les fichiers MEF1 après macro et MEF2 après macro

(Pour le moment ma macro fonctionne)

3) Le traitement finale que je souhaite obtenir est dans MEF1 résultat final et MEF2 resultat final

A noter que , dans l’ordre :

Nom colonne devient

Policy Number devient Membership n°
Star Date devient Subscription date
Cover type réel devient Cover Type
date début finale devient Payment cover date from
date fin finale devient Payment cover date to
Cancel Date devient date of cancellation
Totbill Inc Disc devient Premium
IPT devient Taxes
Underwriting devient Net Premium
Fréquence paiement devient Time frame of payments



Voila, j’espère que c’est plus simple à comprendre lol

Merci de ton aide en tous cas

[Banzai64]

Bonjour

A voir

Attention le nom des colonnes est important

[icecrazy]

Je viens de regarder ce que tu as fait et ca fonctionne nickel

J'ai rajouté quelques bout de code pour la mise en forme etc etc

Il y a pas à dire, bien codé ca va beaucoup plus vite (surtout sur 2 millions de lignes)

Merci pour ton aide