IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Créer une nouvelle colonne sans les espaces


Sujet :

Macros et VBA Excel

  1. #1
    Membre à l'essai
    Inscrit en
    Septembre 2008
    Messages
    23
    Détails du profil
    Informations forums :
    Inscription : Septembre 2008
    Messages : 23
    Points : 11
    Points
    11
    Par défaut Créer une nouvelle colonne sans les espaces
    Bonjour,

    Je suis en train de créer un programme en deux etapes
    On part de 2 colonnes A et B de references dont certaines se retrouvent dans ces deux colonnes.
    Le but est de créer 3 nouvelles colonnes avec une des reference qui sont seulement dans la colonne 1, la seconde avec les references qui ne sont que dans la colonne 2 et la troisieme avec les references se trouvant dans les deux colonnes.
    Pour corser l'affaire il faut enlever les espaces des references de la colonne 2 pour pouvoir faire la comparaison.

    Voila ou en et mon programme. (Etant donné que je suis débutant j'ai vite bloqué).



    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    Public Sub comparaison()
     
    Dim i, j, k As Integer
    Dim Cell  As Range
    Dim newsaintlaurent As Variant
     
     
    Windows(" Delta CP1-CP2 sur ASG.xls").Activate
     
    'On compare les cellules
     
     
        Range("A1").Select  'On se place sur la première des 2 colonnes
        DernièreLigne = ActiveCell.End(xlDown).Row
        Maplage = Range(Cells(1, 1), Cells(DernièreLigne, 1)).Address
     
        Range("B1").Select  'On se place sur la deuxième des 2 colonnes
        DernièreLigne2 = ActiveCell.End(xlDown).Row
        Maplage2 = Range(Cells(1, 2), Cells(DernièreLigne2, 2)).Address
     
    i = 2
     
    While Cells(i, 2) <> ""
     
    Maplage2new = Replace(Maplage2, " ", "")
    Cells(i, 4) = Maplage2new(i)
    i = i + 1
     
    Wend
     
        For Each Cel In Range(Maplage)
            ok = Cel.Value <> Cells(Cel.Row, Cel.Column + 4).Value
            If ok Then Cells(Cel.Row, Cel.Column + 6).Value = Cel.Value
        Next Cel
     
    Cells(1, 6) = "A et B"
    Cells(1, 7) = "A"
    Cells(1, 8) = "B"
     
    Columns(1).AutoFit
    Columns(2).AutoFit
    Columns(3).AutoFit
    Columns(4).AutoFit
    Columns(5).AutoFit
    Columns(6).AutoFit
    Columns(7).AutoFit
    Columns(8).AutoFit
     
     
     
    End Sub
    Merci pour votre aide

  2. #2
    Membre averti
    Profil pro
    Inscrit en
    Février 2006
    Messages
    288
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2006
    Messages : 288
    Points : 364
    Points
    364
    Par défaut
    Dans le temps j'avais fait une macro qui servait à ça, je l'ai retrouvée.
    C'était une de mes premières macros (soupir ému ), je ferais sans doute différemment maintenant mais bon ça marchait :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
     
    Sub Comparaison()
     
    Dim EnrCol1(65000) As String
    Dim EnrCol2(65000) As String
    Dim li As Long
    Dim a As Long
    Dim b As Long
    Dim FinCol1 As Long
    Dim FinCol2 As Long
    Dim Pointeur3 As Long
    Dim Pointeur4 As Long
    Dim Pointeur5 As Long
    Dim Correspondance As Boolean
     
    Pointeur3 = 2 'servira à savoir où on en est dans la colonne 3
    Pointeur4 = 2 'idem avec la colonne 4
    Pointeur5 = 2 'idem avec la colonne 5
     
    'on recherche la fin de chaque colonne :
    Range("A65000").Select
    Selection.End(xlUp).Select
    FinCol1 = ActiveCell.Row
     
    Range("B65000").Select
    Selection.End(xlUp).Select
    FinCol2 = ActiveCell.Row
     
     
    'on met en mémoire les données de la colonne 1
    a = 1
    li = 1
    Do Until li > FinCol1
        If Cells(li, 1).Value <> "" Then
            EnrCol1(a) = Trim(Cells(li, 1).Value)
            a = a + 1
        End If
        li = li + 1
    Loop
     
    'on met en mémoire les données de la colonne 2
    a = 1
    li = 1
    Do Until li > FinCol2
        If Cells(li, 2).Value <> "" Then
            EnrCol2(a) = Trim(Cells(li, 2).Value)
            a = a + 1
        End If
        li = li + 1
    Loop
     
     
    'Préparation des colonnes C,D,E
     
    Cells(1, 3) = "Entrées communes"
    Cells(1, 4) = "Dans Col A & pas dans Col B"
    Cells(1, 5) = "Dans Col B & pas dans Col A"
        Range("C1:E1").Select
        Selection.Font.Bold = True
        Columns("C:E").Select
        Selection.NumberFormat = "@"
        Selection.Columns.AutoFit
        With Selection
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .ShrinkToFit = False
            .MergeCells = False
        End With
        Range("A1").Select
     
    'on vérifie maintenant si les données de la colonne 1 sont dans la colonne 2
    a = 1
    Do Until a > FinCol1
        Correspondance = False
        For b = 1 To FinCol2
            If UCase(EnrCol1(a)) = UCase(EnrCol2(b)) Then
                Cells(Pointeur3, 3) = EnrCol1(a)
                Pointeur3 = Pointeur3 + 1 's'il y a correspondance ont met l'entrée dans la colonne 3
                Correspondance = True
                b = FinCol2
            End If
        Next b
     
        If Correspondance = False Then
            Cells(Pointeur4, 4) = EnrCol1(a) 's'il n'y a pas correspondance on met les données dans la colonne 4
            Pointeur4 = Pointeur4 + 1
        End If
        a = a + 1
    Loop
     
     
    'on vérifie maintenant si les données de la colonne 2 sont dans la colonne 1
    a = 1
    Do Until a > FinCol2
        Correspondance = False
        For b = 1 To FinCol1
            If UCase(EnrCol2(a)) = UCase(EnrCol1(b)) Then
                Correspondance = True
                b = FinCol1
            End If
        Next b
     
        If Correspondance = False Then
            Cells(Pointeur5, 5) = EnrCol2(a) 's'il n'y a pas correspondance on met les données dans la colonne 5
            Pointeur5 = Pointeur5 + 1
        End If
        a = a + 1
    Loop
     
    End Sub
    Précision : il y a des Trim et des UCase pour ne tenir compte ni des espaces aux extrémités ni de la casse.

  3. #3
    Membre du Club
    Profil pro
    Inscrit en
    Septembre 2008
    Messages
    92
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Septembre 2008
    Messages : 92
    Points : 58
    Points
    58
    Par défaut
    Moi je ferai un truc un peu plus simple.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
     
    Sub Compare()
        'Définit les 3 variables dont on a besoin
        Dim Ligne As Integer
        Dim ColA As String, ColB As String
     
        'Définit le nombre de lignes actives dans les listes
        Ligne = ActiveSheet.UsedRange.Rows.Count
     
        For i = 1 To Ligne
            'Crée une variable texte sans espace pour chaque colonne à comparer
            ColA = Replace(Cells(i, 1), " ", "")
            ColB = Replace(Cells(i, 2), " ", "")
     
            'Ecrit les valeurs dans les nouvelles colonnes
            Cells(i, 7) = Cells(i, 1)
            Cells(i, 8) = Cells(i, 2)
     
            'Compare si les colonnes 1 et 2 sont différentes, et les copie dans une 3e colonne
            If ColA <> ColB Then Cells(i, 6) = Cells(i, 1) & " " & Cells(i, 2)
        Next
     
        'Mets en forme les colonnes
        Cells(1, 6) = "A et B"
        Cells(1, 7) = "A"
        Cells(1, 8) = "B"
     
        For i = 1 To 8
            Columns(i).AutoFit
        Next
    End Sub
    Je sais pas si j'ai bien compris la fonction de ton code, mais au pire, tu n'as plus que quelques variables à modifier.

    Phil....

  4. #4
    Membre à l'essai
    Inscrit en
    Septembre 2008
    Messages
    23
    Détails du profil
    Informations forums :
    Inscription : Septembre 2008
    Messages : 23
    Points : 11
    Points
    11
    Par défaut Essai demain
    Bonsoir,
    Je rentre seulement du travail et jesuis invité ce soir je vous dirais le résultat.
    En tout cas je vous remercie beaucoup de m'avoir répondu rapidement.

Discussions similaires

  1. Réponses: 3
    Dernier message: 10/02/2014, 01h34
  2. Réponses: 4
    Dernier message: 29/04/2013, 17h29
  3. Réponses: 2
    Dernier message: 16/04/2010, 13h04
  4. Réponses: 3
    Dernier message: 03/02/2010, 15h56
  5. [XL-2007] insérer une nouvelle colonne tous les trois colonnes
    Par franckimmo dans le forum Macros et VBA Excel
    Réponses: 46
    Dernier message: 21/08/2009, 19h55

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo