Déplacer des colonnes entières VBA

Bonjour,

Je suis actuellement en stage dans une boite. Je suis affecté au support technique et on me demande de développer des macros VBA. Je n'avais jamais utilisé le Visual Basic et j'ai plutôt le profil du tekos que du développeur d'où mon appel au secours içi

Donc on m'a assigné un ticket et ma mission est de créer une procédure qui traiterait des fichiers de subventions au format .xls pour les rendre compatible pour une autre application.

Les fichiers sortants doivent être au format .csv .

Pour le moment c'est un gars de la boite qui ouvre les fichiers un par un, qui fait les modifications nécessaire et enregistre ensuite le fichier au format csv.

Du coup les modif à faire sont :

-Concaténer les colonnes "Genre" "Nom" "Prénom" 3 colonnes dans l'xls, une seule colonne "Genre Nom Prenom" pour le .csv

-Virer tous les accents et caractères spéciaux

-Vérifier que les cellules des colonnes "Société" et "Adresse" ne comporte pas plus de 38 caractères et proposer une modification si c'est le cas (par fenêtre pop up ou j'sais pas trop encore, je sens que ça va être fun)

-Vérifier et remplacer les code postaux qui ont moins de 5 caractères (l'xls d'origine coupe le 0 si il est en début de code postal, on a donc quelques CP à 4 chiffres)

-Vérifier le bon ordre des colonnes !

Donc ma demande aujourd’hui s'appui sur le dernier point lister ci-dessus...

En fait suivant les fichiers xls on a pas tout le temps le même ordre dans les colonnes.

Un fichier modèle (xls) devrait avoir 8 colonnes dans cet ordre : Numéro / Genre / Prénom / Nom / Société / Rue / Code Postal / Ville

Cet ordre n'est pas toujours respecté et je dois faire en sorte que la procédure que je tente de mettre en place gère ce problème.

Donc si jamais un fichier sub.xls avait des colonnes : (Numéro / Genre / Prénom / Nom / Ville / Rue / Société / Code Postal la procédure devra corriger ça pour remettre les colonnes dans l'ordre.

Du coup je ne sais pas vraiment comment procéder... en fait je crois que je suis plus à la recherche d'une aide pour l'élaboration de l'algo plutôt que du code VBA.

Je suis donc preneur de conseils, d'échanges d'idées.

Merci d'avance

Erwann.

Bonjour,

A mon avis tu peux imaginer un code avec une boucle qui va de nombre de colonnes jusqu'à 1 step -1

dans cette boucle tu mets un if la valeur de la cellule (1,i) correspond à la valeur i ne rien faire sinon couper la colonne et la coller au bon endroit.

Ca ne devrait pas être trop compliqué à faire, et comme tu es en stage, le mieux c'est que tu apprennes à le faire par toi même

Si tu as des complications reviens avec une proposition et on peut regarder ça ensemble.

Merci pour le retour je regarde ça dans la soirée

Bonjour,

Comme tu doit aussi supprimer les accents des différents mots, je suggère de stocker les valeurs de ta feuille dans un tableau car plus rapide pour boucler. Pour la suppression des accents, il te faut boucler sur chaque lettres de chaque mots donc ça prend du temps. Pour l'ordre, si tes colonnes ont des entêtes, il suffit de contrôler en bouclant si elles sont dans le bon ordre, si pas d'entêtes mais qu'elles sont comme présentées dans ton post, le CP en dernière colonne il te suffit de contrôler la valeur retournée (True ou False) par la fonction IsNumeric(). Ceci retourne Vrai (True) :

MsgBox IsNumeric("04200")

Ceci retourne Faux (False) :

MsgBox IsNumeric("B4200")

Pour résumer, dans ta boucle, dans un second tableau tu récupères la valeur de la première colonne (Numéro) puis tu concatènes tes 3 colonnes ("Genre" "Nom" "Prénom") et tu supprimes les accents tu contrôles si la dernière colonne est le CP ou non et tu récupères les autres valeurs en conséquence. Une fois ton second tableau rempli, tu peux le coller dans une nouvelle feuille et supprimer la feuille originelle puis enregistrer en .csv

Une fonction pour la suppression des accents :

Function SansAccent(Chaine As String) As String

    Dim Tempo As String
    Dim I As Long
    Dim Pos As Long

    Const Avec As String = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
    Const Sans As String = "AAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinooooouuuuyy"

    Tempo = Chaine

    For I = 1 To Len(Tempo)

        Pos = InStr(Avec, Mid(Tempo, I, 1))
        If Pos > 0 Then Mid(Tempo, I, 1) = Mid(Sans, Pos, 1)

    Next I

    SansAccent = Tempo

End Function

Je n'ai malheureusement pas eu le temps hier soir de jeter un coup d’œil au projet du coup j'my recolle ce matin !

Merci Theze pour ton post , j'avais déjà "codé" une procédure Sub pour enlever les accents.

Option Explicit

Sub EnleveAccent()
Dim accent
Dim SansAccent
Dim i

    accent = Array("à", "â", "ä", "é", "è", "ê", "ë", _
                "î", "ï", "ô", "ö", "ù", "û", "ü", "ñ")
    SansAccent = Array("a", "a", "a", "e", "e", "e", "e", _
                    "i", "i", "o", "o", "u", "u", "u", "n")

            With Cells.SpecialCells(xlCellTypeConstants, 23)
                For i = 0 To 14
                  .Replace accent(i), SansAccent(i)
             Next i
            End With
End Sub

J'ai lu qu'il était fortement conseillé de commencé ses Sub avec "Option explicit" j'ai compris que c'était pour forcer la déclaration des variables d'ou ma déclaration un peu approximatif en début de sub... je ne sais pas quel type je dois déclarer...mais ça fonctionne comme ça pour le moment.

Bon j'ai bien galéré avec les tableaux, c'est long l'apprentissage !

J'adore ça !

Du coup j'ai pas fini et j'ai un peu faim donc en route pour la cafet' du coin mais ce matin j'ai eu le temps de codé un peu ma procédure pour les colonnes.

Option Explicit
Sub verifCol()

'declaration des tableaux
Dim cel As Variant
Dim titres(7) As Variant
Dim titresVoulu As Variant

Dim i As Integer

'remplissage des tableaux en dur avec les informations souhaités (bon ordre des colonnes)
cel = Array("A1", "B1", "C1", "D1", "E1", "F1", "G1", "H1")
titresVoulu = Array("Numéro", "Genre", "Prénom", "Nom", "Société", "Rue", "Code Postal", "Ville")

'boucle pour remplir le tableau avec les données actuelles de la feuille
For i = 0 To 7
titres(i) = Range(cel(i)).Value
Next i

'boucle pour comparer l'ordre des titres des colonnes du document (titres(7)) à l'ordre de colonne souhaité (titresVoulu(7))
For i = 0 To 7
If titres(i) <> titresVoulu(i) Then

MsgBox "error ! NUL !"

Else: MsgBox "ouais ouais ouais!"
End If
Next i

End Sub

Donc la ça marche, je sais pas trop si c'est propre comme code par contre .

Me reste a remplacer le message d'erreur par une procédure de changement de position de la colonnes pour prendre la bonne position.

J'ai avancé un petit peu entre deux tickets de support.

Option Explicit
'Procedure pour verifier que les colonnes du documents .xls sont bien dans le bon ordre,
' "numero, genre, prenom, nom, societe, rue, code postal, ville"
'et les remettre dans le bonne ordre en cas d'erreur
Sub verifCol()

'declaration des tableaux
Dim cel As Variant
Dim titres(7) As Variant
Dim titresVoulu As Variant

Dim i As Integer

'remplissage des tableaux en dur avec les informations souhaitees (bon ordre des colonnes)
cel = Array("A1", "B1", "C1", "D1", "E1", "F1", "G1", "H1")
titresVoulu = Array("Numéro", "Genre", "Prénom", "Nom", "Société", "Rue", "Code Postal", "Ville")

'boucle pour remplir le tableau avec les donnees actuelles de la feuille
    For i = 0 To 7
        titres(i) = Range(cel(i)).Value
    Next i

'Declaration des variables pour utiliser la fonction find et chercher la bonne colonne a deplacer en cas derreur
Dim resultat As String
Dim plageDeRecherche As Range
Dim trouve As Range
Dim position As String

'on prend la premiere ligne comme plage de recherche pour le titre de la colonne
Set plageDeRecherche = ActiveSheet.Rows(1)

    'boucle pour comparer l'ordre des titres des colonnes du document (titres(7)) à l'ordre de colonne souhaitee (titresVoulu(7))
    'et recherche de la bonne colonne en cas derreur
    For i = 0 To 7
        If titres(i) <> titresVoulu(i) Then
            resultat = titresVoulu(i)
            Set trouve = plageDeRecherche.Cells.Find(What:=resultat, LookAt:=xlWhole)
            trouve.EntireColumn.Select
            Selection.Cut
            position = Cells(1, i + 1)
            Cells(1, i + 1).Select

               If position <> resultat Then

                 Selection.Insert
               Else
               End If
         Else

        End If

     Next i

End Sub

Voila ma procédure terminé. ça fonctionne.

Il y a quand même un truc qui me chiffonne, c'est que j'utilise le presse papier avec les fonctions Cut et Insert (enfin je crois...).

Et j'ai lu que le presse papier était uniquement un outil disponible pour l’utilisateur mais certainement pas pour un programme (ou une macro).

Ce que je comprend tout à fait. Du coup je me demande si j'ai moyen de faire autrement... peut être en stockant les données de la colonne a replacer dans un autre tableau et redistribué dans la bonne colonne ces données ?

Salut,

C'est un très bon début mais ce qui serait intéressant c'est que ta macro corrige l'erreur automatiquement. C'est bien que tu aies mis option Explicit.

Au niveau du code, attention au type de déclaration, "Variant" marche mais consomme trop de ressources. Plus tard tu vas faire des procédures qui auront besoin de plus de ressources et donc tu vas faire planter la machine ou à minima augmenter le temps de traitement.

Du coup, pour i un type "Byte" suffira car la valeur est inférieure à 255

titre as String

titresvoulus as string

cel as string

Si tu t'arrêtes là, tu peux éviter de déclarer le tableau cel en utilisant la boucle suivante, mais tu en auras besoin plus tard si tu décides de continuer le code pour corriger l'erreur:

For i = 0 To 7
titres(i) = Cells(1,i).Value
Next i

Comme tu boucles de 0 à 7 à chaque fois, tu peux mettre le tout dans la même boucle For.

Dernière remarque cette fois sur la forme, lorsque tu codes à l'intérieur d'une boucle, l'usage fait que l'on met un tab pour décaler le code, simple question de visibilité pour voir qu'on est sur la 2ème boucle (maintenance, évolution, travail en équipe, etc.)

For i = 0 To 7
    If titres(i) <> titresVoulu(i) Then
        MsgBox "error ! NUL !"
    Else
        MsgBox "ouais ouais ouais!"
    End If
Next i

Bonjour,

Il y a quand même un truc qui me chiffonne, c'est que j'utilise le presse papier avec les fonctions Cut et Insert (enfin je crois...).

Et j'ai lu que le presse papier était uniquement un outil disponible pour l’utilisateur mais certainement pas pour un programme (ou une macro).

Si tu ne veux pas utiliser le presse papier (je n'en suis pas trop fan non plus bien que ça ne soit pas un problème), tu peux utiliser des plages et les inverser :

Sub InverserColonnes()

    Dim Plage1 As Range
    Dim Plage2 As Range
    Dim Cel As Range
    Dim Tempo
    Dim I As Integer
    Dim TitresVoulus

    'ordre des entêtes
    TitresVoulus = Array("Numéro", "Genre", "Prénom", "Nom", "Société", "Rue", "Code Postal", "Ville")

    'bouclage sur le tableau d'entêtes
    For I = 0 To UBound(TitresVoulus)

        'si non correspondance...
        If Cells(1, I + 1).Value <> TitresVoulus(I) Then

            'effectue une recherche du mot dans la 1ère ligne...
            Set Cel = Rows(1).Find(TitresVoulus(I), , xlValues, xlWhole)

            'si trouvé, défini les deux plages sur les colonnes à inverser et effectue l'inversion
            If Not Cel Is Nothing Then

                With ActiveSheet: Set Plage1 = .Range(.Cells(1, I + 1), .Cells(.Rows.Count, I + 1).End(xlUp)): End With
                With ActiveSheet: Set Plage2 = .Range(.Cells(1, Cel.Column), .Cells(.Rows.Count, Cel.Column).End(xlUp)): End With

                Tempo = Plage1
                Plage1.Value = Plage2.Value
                Plage2 = Tempo

            'si pas trouvé (mauvaise orthographe probablement), message et fin !
            Else

                MsgBox "Erreur dans l'orthographe du mot '" & TitresVoulus(I) & "' !"
                Exit Sub

            End If

        End If

    Next I

End Sub

Au niveau du code, attention au type de déclaration, "Variant" marche mais consomme trop de ressources. Plus tard tu vas faire des procédures qui auront besoin de plus de ressources et donc tu vas faire planter la machine ou à minima augmenter le temps de traitement.

Du coup, pour i un type "Byte" suffira car la valeur est inférieure à 255

titre as String

titresvoulus as string

cel as string

J'ai testé mais quand je déclare les tableaux avec String j'ai une erreur de compilation "Expected Array" .

Merci pour les différents conseils en tout cas

Bonjour Theze,

J'ai testé ta macro, elle fonctionne très bien et elle a l'air beaucoup plus rapide/fluide que ce que j'avais codé :°

Par contre j'ai un peu de mal à appréhender la partie inversion de colonne.

'si trouvé, défini les deux plages sur les colonnes à inverser et effectue l'inversion

If Not Cel Is Nothing Then

With ActiveSheet: Set Plage1 = .Range(.Cells(1, I + 1), .Cells(.Rows.Count, I + 1).End(xlUp)): End With

With ActiveSheet: Set Plage2 = .Range(.Cells(1, Cel.Column), .Cells(.Rows.Count, Cel.Column).End(xlUp)): End With

Tempo = Plage1

Plage1.Value = Plage2.Value

Plage2 = Tempo

Bonjour,

Deux plages sont définies (Plage1 et Plage2) et la variable "Tempo" déclarée Variant est utilisée pour stocker momentanément la première plage "Tempo = Plage1", la ligne "Plage1.Value = Plage2.Value" tranfère les valeurs de la plage Plage2 dans la plage Plage1 et ensuite, un fois le transfert effectué, on récupère dans la plage Plage2 les valeurs de la plage Plage1 qui étaient stockées dans la variable avec "Plage2 = Tempo"