Discussion :

[BRUNO71]

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....

[Marc-L]

'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, …

[Invité]

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.

[BRUNO71]

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..

[Invité]

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.

[BRUNO71]

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.

[Marc-L]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Demo()
            Dim Rc As Range, Rg As Range, VA
            VA = Feuil2.Cells(1).CurrentRegion.Columns(14).Value
    With Feuil1.Cells(1).CurrentRegion.Rows
        For Each Rc In .Item("2:" & .Count).Columns(14).Cells
            If IsError(Application.Match(Rc.Value, VA, 0)) Then If Rg Is Nothing Then Set Rg = Rc Else Set Rg = Union(Rc, Rg)
        Next
    End With
    If Not Rg Is Nothing Then
           Rg.EntireRow.Delete
       Set Rg = Nothing
    End If
End Sub

[Marc-L]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Demo2()
        Dim R&, VA
        VA = Feuil2.Cells(1).CurrentRegion.Columns(14).Value
        Application.ScreenUpdating = False
    With Feuil1
        For R = .Cells(1).CurrentRegion.Rows.Count To 2 Step -1
           With .Cells(R, 14)
               If IsError(Application.Match(.Value, VA, 0)) Then .EntireRow.Delete
           End With
        Next
    End With
        Application.ScreenUpdating = True
End Sub

______________________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé …