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 :

Supprimer ligne unique et non les doublons. [XL-2007]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre éclairé Avatar de BRUNO71
    Homme Profil pro
    Retraité
    Inscrit en
    Janvier 2007
    Messages
    507
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 63
    Localisation : France, Saône et Loire (Bourgogne)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 507
    Par défaut Supprimer ligne unique et non les doublons.
    Bonjour à vous,
    Je suis toujours dans la bricole avec excel et j'ai une question à vous poser :
    Comment faire pour comparer la colonne N de la feuil1 avec la colonne N de la feuil2 et supprimer la ligne complète si un mot est UNIQUE dans la colonne N de la feuil1...?
    Le mot unique ne peut se trouver que dans la colonne N de la feuil1..et c'est cette ligne que je souhaite supprimer....
    J'ai du mal à me comprendre, suis-je clair !

    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
     
     Sub essai()
        Set BDD1 = Sheets("Feuil1")
        Set BDD2 = Sheets("Feuil2")
     
        Ligne = 2 'A partir de la lligne 2
     
        nblignes = BDD1.[A65000].End(xlUp).Row + 1
        For i = 2 To nblignes
          x = TrimZéro(Trim(BDD1.Cells(i, 14)))
     
          Set c = BDD2.[N:N].Find(what:=x, LookAt:=xlPart, MatchCase:=False)
          If c Is Nothing Then
     
             Ligne = Ligne + 1
             BDD1.Cells(i, 14).Interior.ColorIndex = 7
          End If
        Next i
    End Sub
     
    Function TrimZéro(x)
      i = 1
      Do While Mid(x, i, 1) = "0" And i < Len(x)
        i = i + 1
      Loop
      TrimZéro = Mid(x, i)
    End Function
    Depuis ce bout de code je galère....Je coloris le chiffre unique....mais si la case est vide en A1 ça ne fonctionne pas..
    Si plusieurs champs alors là plus rien....et le but serait de remplacer le coloriage par la suppression de la ligne.
    En fait c'est probable que j'ai douze mots identiques entre la N Feuil1 et la N Feuil2 et par exemple 5 nouveaux dans la N Feuil1....et la je supprime la ligne....enfin, comment faire ?

    Merci....

  2. #2
    Expert éminent
    Avatar de Marc-L
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Avril 2013
    Messages
    9 468
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Avril 2013
    Messages : 9 468
    Par défaut


    'soir !

    J'entr'aperçois à peu près mais quand je regarde le code cela devient flou !
    Pourquoi ne remplaces-tu pas le coloriage par la suppression ?!

    Joindre un classeur exemple en .xlsx (donc sans code !) avec les feuilles 1 & 2 et une feuille résultat désiré …

    ______________________________________________________________________________________________________
    Je suis Paris, Charlie, Bruxelles, …

  3. #3
    Invité
    Invité(e)
    Par défaut
    Bonjour à tous,

    Une solution possible :

    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
    Sub EssaiSuppressionLigneBdd1()
     
    Dim Bdd1 As Worksheet
    Dim DerniereLigneBdd1 As Long
     
    Dim AireBdd2 As Range
    Dim CelluleBdd2 As Range
    Dim DerniereLigneBdd2 As Long
     
    Dim J As Long
     
        Set Bdd1 = Sheets("Feuil1")
     
        With Sheets("Feuil2")
             DerniereLigneBdd2 = .Cells(.Rows.Count, 14).End(xlUp).Row
             Set AireBdd2 = .Range(.Cells(1, 14), .Cells(DerniereLigneBdd2, 14))
        End With
     
        For Each CelluleBdd2 In AireBdd2
            With Bdd1
                 DerniereLigneBdd1 = .Cells(.Rows.Count, 14).End(xlUp).Row
                 For J = DerniereLigneBdd1 To 2 Step -1
                     If .Cells(J, 14) <> "" Then
                        If CelluleBdd2 = Val(TrimZero(.Cells(J, 14))) Then  ' Nb : Vérifier le type des contenus respectifs
                           .Cells(J, 14).Interior.ColorIndex = 7
                           '.Rows(J).Delete  ' Pour supprimer directement la ligne
                           ' Exit For   ' S'il n'y a pas d'autres lignes possibles dans Bdd1
                        End If
                     End If
                 Next J
            End With
        Next CelluleBdd2
     
        Set AireBdd2 = Nothing
        Set Bdd1 = Nothing
     
    End Sub
     
    Function TrimZero(ByVal X As String) As Variant
     
    Dim I As Integer
     
        I = 1
        TrimZero = ""
        For I = 1 To Len(X)
            Select Case Mid(X, I, 1)
                   Case "'", "0"
                        I = I + 1
                   Case Else
                        Exit For
            End Select
        Next I
        TrimZero = Trim(Mid(X, I))
     
    End Function
    Marc a raison quand il demande le fichier, il faut connaître le type de données comparées pour réaliser le code. Dans mon exemple, j'ai supposé que les valeurs étaient des nombres entiers.
    Nb :
    - Le "'" dans la fonction n'est pas forcément nécessaire, il m'a servi à modéliser l'exemple.
    - Le choix des boucles For Next et les variables non accentuées tiennent seulement à l'habitude.

    Cordialement.

  4. #4
    Membre éclairé Avatar de BRUNO71
    Homme Profil pro
    Retraité
    Inscrit en
    Janvier 2007
    Messages
    507
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 63
    Localisation : France, Saône et Loire (Bourgogne)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 507
    Par défaut
    Bonjour à vous deux,

    Je tiens à vous remercier par avance.
    Voici mon fichier....peu importe ce qui se trouve entre A et M le tout c'est de supprimer la ligne complète..
    Par exemple les lignes seraient la 7 et la 12...

    Merci..

  5. #5
    Invité
    Invité(e)
    Par défaut
    Une solution possible :

    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
     
    Sub EssaiSuppressionLigneBdd1_V2()
     
    Dim Bdd1 As Worksheet
    Dim DerniereLigneBdd1 As Long
     
    Dim AireBdd2 As Range
    Dim CelluleBdd2 As Range
    Dim DerniereLigneBdd2 As Long
     
    Dim J As Long
     
    Dim Continuer  As Boolean
     
        Set Bdd1 = Sheets("Feuil1")
     
        With Sheets("Feuil2")
             DerniereLigneBdd2 = .Cells(.Rows.Count, 14).End(xlUp).Row
             Set AireBdd2 = .Range(.Cells(1, 14), .Cells(DerniereLigneBdd2, 14))
        End With
     
        With Bdd1
             DerniereLigneBdd1 = .Cells(.Rows.Count, 14).End(xlUp).Row
     
             For J = DerniereLigneBdd1 To 2 Step -1
                 Continuer = True
                 If .Cells(J, 14) <> "" Then
     
                    For Each CelluleBdd2 In AireBdd2
                             If CelluleBdd2 = TrimZero(.Cells(J, 14)) Then Continuer = False
                    Next CelluleBdd2
     
                    If Continuer = True Then
                      ' .Cells(J, 14).Interior.ColorIndex = 7
                       .Rows(J).Delete  ' Pour supprimer directement la ligne
                    End If
                End If
            Next J
        End With
     
        Set AireBdd2 = Nothing
        Set Bdd1 = Nothing
     
    End Sub
    Cordialement.

  6. #6
    Membre éclairé Avatar de BRUNO71
    Homme Profil pro
    Retraité
    Inscrit en
    Janvier 2007
    Messages
    507
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 63
    Localisation : France, Saône et Loire (Bourgogne)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 507
    Par défaut
    C'est super....

    Merci, en fait je bricole en prenant des exemples par ci par là.
    Mais je perds beaucoup de temps....seul dans mon coin...

    Merci beaucoup, je vais pouvoir continuer à travailler....

    Merci Eric...et Marc.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2010] Supprimer ligne entière si cellule en doublon
    Par GuillaumeNcy dans le forum Excel
    Réponses: 3
    Dernier message: 13/01/2015, 08h52
  2. Réponses: 3
    Dernier message: 06/03/2014, 21h44
  3. Réponses: 3
    Dernier message: 22/03/2010, 10h14
  4. Supprimer les doublons avec order by non affiché
    Par DidRocks dans le forum Oracle
    Réponses: 1
    Dernier message: 19/09/2007, 10h42
  5. Réponses: 2
    Dernier message: 14/06/2007, 23h24

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