XL 2010 Comparaison de deux tableaux et suppression de lignes

D

Deliau

XLDnaute Nouveau
Bonjour,

Je dispose de deux tableaux.
Dans le premier (Classeur1) la liste de toutes les routes et ronds-points (ouverts à la circulation) d'une carte.
Dans le second (Classeur2), une liste de chemin empruntant certains de ces routes et ronds-points.

Je souhaite supprimer les chemins du second tableau si l'une des routes ou ronds-points du premier tableau est absente (donc fermé à la circulation).
J'ai codé en VBA une macro me permettant de comparer un à un les éléments du Classeur1 au Classeur2 puis de supprimer les lignes des chemins absents du Classeur2, mais ce ne sera pas optimisé quand le nombre d'éléments à analyser sera important.

Je souhaite savoir si une fonction d'Excel permet ce tri (ou filtrage ou pré sélection) "automatiquement" ?
Voir le fichier attaché pour l'exemple.

Merci,
Lucie
 

Pièces jointes

  • plan.xls
    50.5 KB · Affichages: 15
Trier par date Trier par votes
D

Deliau

XLDnaute Nouveau
Bonjour Laurent pour ta réponse rapide.

Je n'ai pas le PC avec moi ce week-end, donc pas mon code.
Effectivement, le fichier joint est complet et je supprime certaines lignes dans le Classeur1 pour voir le résultat dans le Classeur 2.

Merci
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Deliau,
Sans fournir votre macro, il est impossible de savoir si celle en PJ est plus performante.
Pas bien compris la requête : Si Nom dans Classeur2 absent de la liste Classeur1, on supprime la ligne dans Classeur2. C'est ainsi que je l'ai compris.
Je souhaite supprimer les chemins du second tableau si l'une des routes ou ronds-points du premier tableau est absente
Cliquez pour agrandir...
VB: 
Sub Essai()
T0 = Timer
Application.ScreenUpdating = False
Supprimée = 1
While Supprimée = 1
    Supprimée = 0
    For Each c In [A1].CurrentRegion
        If Application.WorksheetFunction.CountIf([ListeFermée], c.Value) = 0 Then
            Rows(c.Row & ":" & c.Row).Delete Shift:=xlUp
            Supprimée = 1
        End If
    Next
Wend
Application.ScreenUpdating = True
MsgBox ("Temps traitement pour dix lignes = " & Round((Timer - T0) * 1000, 0) & "ms")
End Sub
 

Pièces jointes

  • plan.xlsm
    26.9 KB · Affichages: 8
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Deliau, laurent3372, sylvanu, mapomme,

D'après ce que je comprends vous pouvez utiliser cette macro :
VB: 
Private Sub Worksheet_Activate()
Dim d As Object, tablo, i&, x$, nlig&, ncol%, resu(), j%, n%
'---liste sans doublon---
Set d = CreateObject("Scripting.Dictionary")
tablo = Feuil1.UsedRange.Columns(1).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
    x = tablo(i, 1)
    If x <> "" Then d(x) = ""
Next
'---tableau des résultats---
With Feuil2.UsedRange
    nlig = .Rows.Count
    ncol = .Columns.Count
    If ncol = 1 Then ncol = 2 'pour avoir au moins 2 éléments
    tablo = .Resize(, ncol)
End With
ReDim resu(1 To nlig, 1 To ncol)
For i = 1 To nlig
    resu(i, 1) = tablo(i, 1): n = 1
    For j = 2 To ncol
        If d.exists(tablo(i, j)) Then n = n + 1: resu(i, n) = tablo(i, j)
Next j, i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est fimtrée
With [A1] '1ère cellule de restitution, à adapter
    .Resize(nlig, ncol) = resu
    .Offset(nlig).Resize(.Parent.Rows.Count - nlig - .Row + 1).EntireRow.ClearContents 'RAZ en dessous
    .Offset(, ncol).Resize(, .Parent.Columns.Count - ncol - .Column + 1).EntireColumn.ClearContents 'RAZ à droite
End With
With UsedRange: End With 'actualise les barres de défilement
End Sub
Elle se déclenche quand on active la feuille "Résultat".

Sur l'exemple toutes les données de la feuille "Classeur2" sont récupérées.

A+
 

Pièces jointes

  • plan(1).xls
    60 KB · Affichages: 5
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Fichier (2) si l'on doit supprimer toute la ligne dès qu'un élément n'existe pas en 1ère feuille :
VB: 
Private Sub Worksheet_Activate()
Dim d As Object, tablo, i&, ncol%, j%, n%
'---liste sans doublon---
Set d = CreateObject("Scripting.Dictionary")
tablo = Feuil1.UsedRange.Columns(1).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
d("") = "" 'pour inclure les vides
For i = 1 To UBound(tablo)
    d(tablo(i, 1)) = ""
Next
'---tableau des résultats---
With Feuil2.UsedRange
    ncol = .Columns.Count
    If ncol = 1 Then ncol = 2 'pour avoir au moins 2 éléments
    tablo = .Resize(, ncol)
End With
For i = 1 To UBound(tablo)
    For j = 2 To ncol
        If Not d.exists(tablo(i, j)) Then Exit For
    Next j
    If j = ncol + 1 Then
        n = n + 1
        For j = 1 To ncol
            tablo(n, j) = tablo(i, j)
        Next j
    End If
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est fimtrée
With [A1] '1ère cellule de restitution, à adapter
    If n Then .Resize(n, ncol) = tablo
    .Offset(n).Resize(.Parent.Rows.Count - n - .Row + 1).EntireRow.ClearContents 'RAZ en dessous
    .Offset(, ncol).Resize(, .Parent.Columns.Count - ncol - .Column + 1).EntireColumn.ClearContents 'RAZ à droite
End With
With UsedRange: End With 'actualise les barres de défilement
End Sub
Edit : j'ai ajouté d("") = "" pour éviter qu'une cellule vide fasse supprimer la ligne.
 

Pièces jointes

  • plan(2).xls
    59.5 KB · Affichages: 8
Dernière édition:
Vote positif 0 Vote négatif
Patrice33740

Patrice33740

XLDnaute Impliqué
Bonjour le Fil,
Re Deliau (ou dlm64 ? ou Basque64 ?)

@chris je reposte :
VB: 
'Ajouter une référence à Microsoft Scripting Runtime
Option Explicit
Sub VerifierChemin()
Dim d As New Dictionary
Dim t As Variant
Dim r As String
Dim i As Long
Dim j As Long
  'Routes ouvertes
  t = Worksheets("Classeur1").Range("A1").CurrentRegion.Value
  For i = LBound(t) To UBound(t)
    d(t(i, 1)) = ""
  Next i
  'Chemins à vérifier
  t = Worksheets("Classeur2").Range("A1").CurrentRegion.Offset(0, 1).Value
  For i = LBound(t) To UBound(t)
    For j = LBound(t, 2) To UBound(t, 2)
      If Not IsEmpty(t(i, j)) Then
        If Not d.Exists(t(i, j)) Then
          ' mémoriser les chemins fermés
          r = r & "," & i & ":" & i
          Exit For
        End If
      End If
    Next j
  Next i
  r = Mid(r, 2)
  ' Effacer les chemins fermés
  If Not r = "" Then Worksheets("Classeur2").Range(r).Delete
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
D

Deliau

XLDnaute Nouveau
job75 à dit:
Fichier (2) si l'on doit supprimer toute la ligne dès qu'un élément n'existe pas en 1ère feuille :
VB: 
Private Sub Worksheet_Activate()
Dim d As Object, tablo, i&, ncol%, j%, n%
'---liste sans doublon---
Set d = CreateObject("Scripting.Dictionary")
tablo = Feuil1.UsedRange.Columns(1).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
d("") = "" 'pour inclure les vides
For i = 1 To UBound(tablo)
    d(tablo(i, 1)) = ""
Next
'---tableau des résultats---
With Feuil2.UsedRange
    ncol = .Columns.Count
    If ncol = 1 Then ncol = 2 'pour avoir au moins 2 éléments
    tablo = .Resize(, ncol)
End With
For i = 1 To UBound(tablo)
    For j = 2 To ncol
        If Not d.exists(tablo(i, j)) Then Exit For
    Next j
    If j = ncol + 1 Then
        n = n + 1
        For j = 1 To ncol
            tablo(n, j) = tablo(i, j)
        Next j
    End If
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est fimtrée
With [A1] '1ère cellule de restitution, à adapter
    If n Then .Resize(n, ncol) = tablo
    .Offset(n).Resize(.Parent.Rows.Count - n - .Row + 1).EntireRow.ClearContents 'RAZ en dessous
    .Offset(, ncol).Resize(, .Parent.Columns.Count - ncol - .Column + 1).EntireColumn.ClearContents 'RAZ à droite
End With
With UsedRange: End With 'actualise les barres de défilement
End Sub
Edit : j'ai ajouté d("") = "" pour éviter qu'une cellule vide fasse supprimer la ligne.
Cliquez pour agrandir...



Bonjour,

Merci job75 pour ton deuxième post (avec la suppression de la ligne).

Comment avoir dans un autre classeur, les lignes supprimées dans Classeur2 car "la route" était absente dans Classeur1 ?

Lucie
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Deliau, le fil,

Utilisez le bon terme : vous voulez une feuille supplémentaire.

Dans ce fichier (3) j'ai ajouté la feuille Lignes supprimées avec cette macro :
VB: 
Private Sub Worksheet_Activate()
Dim d As Object, tablo, i&, ncol%, j%, n%, k%
'---liste sans doublon---
Set d = CreateObject("Scripting.Dictionary")
tablo = Feuil1.UsedRange.Columns(1).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
d("") = "" 'pour inclure les vides
For i = 1 To UBound(tablo)
    d(tablo(i, 1)) = ""
Next
'---tableau des résultats---
With Feuil2.UsedRange
    ncol = .Columns.Count
    If ncol = 1 Then ncol = 2 'pour avoir au moins 2 éléments
    tablo = .Resize(, ncol)
End With
For i = 1 To UBound(tablo)
    If tablo(i, 1) <> "" Then
        For j = 2 To ncol
            If Not d.exists(tablo(i, j)) Then
                n = n + 1
                For k = 1 To ncol
                    tablo(n, k) = tablo(i, k)
                Next k
                Exit For
            End If
        Next j
    End If
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est fimtrée
With [A1] '1ère cellule de restitution, à adapter
    If n Then .Resize(n, ncol) = tablo
    .Offset(n).Resize(.Parent.Rows.Count - n - .Row + 1).EntireRow.ClearContents 'RAZ en dessous
    .Offset(, ncol).Resize(, .Parent.Columns.Count - ncol - .Column + 1).EntireColumn.ClearContents 'RAZ à droite
End With
With UsedRange: End With 'actualise les barres de défilement
End Sub
A+
 

Pièces jointes

  • plan(3).xls
    69.5 KB · Affichages: 4
Vote positif 0 Vote négatif
D

Deliau

XLDnaute Nouveau
Exact, dans une feuille supplémentaire.
Le code ne permet pas d'identifier "l'objet ou les objets" absents : "route" ou "rondpoint".
Est-ce possible de l'indiquer dans cette nouvelle feuille ?
Exemple :
chemin0route1rondpoint1route2
ou route1, rondpoint1 et route2 était absent dans Classeur1
Merci.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Définir le nom Base =Classeur1!$A:$A

Dans la feuille Lignes supprimées créez une MFC sur les colonnes B:S :
Code: 
=SI($A1<>"";NON(NB.SI(Base;B1)))
Fichier (3 bis).
 

Pièces jointes

  • plan(3 bis).xls
    53.5 KB · Affichages: 4
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
XL 2013 Macro qui compare deux tableaux et supprime des lignes selon un critère.
Réponses
4
Affichages
254
manu49300
M
L
  • Question
Microsoft 365 Comparaison des cellules de deux tableaux avec les fonctions recherchev et/ou ESTNA
Réponses
9
Affichages
175
chris
chris
D
  • Résolu(e)
XL 2021 VBA - Copies de données entre deux tableaux structurés avec plusieurs conditions
Réponses
5
Affichages
434
Drapela
D
D
  • Question
XL 2010 fond blanc et gris dans plusieurs tableaux
Réponses
1
Affichages
321
TooFatBoy
TooFatBoy
M
  • Résolu(e)
Microsoft 365 Copier/coller - Ajout/suppression lignes automatiques
Réponses
6
Affichages
721
M.Ben
M
L
  • Question
Power Query groupés deux tableaux qui existent sur la même feuille et ajout d'information supplémentaire
Réponses
7
Affichages
627
Aurelili
A
D
  • Question
Microsoft 365 macro suppression de lignes dans un tableau
Réponses
3
Affichages
520
Hasco
Hasco
G
  • Question
Microsoft 365 Transfert de données
Réponses
7
Affichages
347
GClaire
G
L
  • Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
604
fanfan38
fanfan38
D
  • Question
Autres Un exemple de résultats pour un examen de secourisme
Réponses
7
Affichages
763
delta6x
D

Membres actuellement en ligne

2 membres et 42 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 196
Messages
2 086 101
Membres
103 116
dernier inscrit
kutobi87