XL 2010 Comparaison de deux tableaux et suppression de lignes

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Deliau
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
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

Trier par date Trier par votes
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
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

Dernière édition:
Vote positif 0 Vote négatif
Bonjour @Deliau, @sylvanu 🙂

Une autre macro normalement très rapide aussi.

edit: bonjour @laurent3372

Errata: mal réveillé, j'avais inclus la colonne A dans la constitution du chemin 😵🙁😡.
Je mets la version v2 (juste replacé 1 par 2 dans une boucle)
Mille + une excuses 😳
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
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

Vote positif 0 Vote négatif
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

Dernière édition:
Vote positif 0 Vote négatif
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
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
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

Vote positif 0 Vote négatif
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
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Z
  • Résolu(e)
Microsoft 365 Suppression des doublons et lignes vide
Réponses
6
Affichages
101
zilio
Z
S
  • Question Question
Microsoft 365 Liaison de données sur deux tableurs
Réponses
7
Affichages
379
AtTheOne
AtTheOne
F
  • Question Question
XL 2021 Power Query : extraire tableaux et données de PDF
Réponses
0
Affichages
178
Florent74
F
P
  • Résolu(e)
Microsoft 365 Macro Excel pour effectuer des opérations sur les lignes et cellules adjacentes
2
Réponses
19
Affichages
159
Perceval973
P
L
  • Résolu(e)
Power Query Problème de fusion de données entre deux fichiers Excel sous Power Query
Réponses
8
Affichages
109
chris
chris
M
  • Résolu(e)
XL 2013 Macro qui compare deux tableaux et supprime des lignes selon un critère.
Réponses
4
Affichages
484
manu49300
M
N
  • Question Question
Microsoft 365 afficher/masquer des lignes en fonction de la valeur d'une cellule qui aura été renseignée par une autre feuille (via un copier/collé automatique)
Réponses
5
Affichages
520
Nel'
N
L
  • Question Question
Microsoft 365 Comparaison des cellules de deux tableaux avec les fonctions recherchev et/ou ESTNA
Réponses
9
Affichages
463
chris
chris
C
  • Résolu(e)
Copier/Masquer des lignes de couleur pour alimenter un tableau
Réponses
9
Affichages
607
vgendron
vgendron
O
  • Résolu(e)
Microsoft 365 Amélioration/réparation d'une Macro et création d'un bouton pour calcul consommation
2
Réponses
27
Affichages
752
Olihoes
O
Claudy
  • Question Question
Microsoft 365 Impression de deux tableaux sur deux pages
Réponses
5
Affichages
446
job75
job75
J
  • Question Question
XL 2021 reporter des données entre plusieurs feuilles sans décalage de lignes dans les tableaux
Réponses
4
Affichages
649
job75
job75
G
  • Question Question
Microsoft 365 Transfert de données
Réponses
7
Affichages
722
GClaire
G
M
  • Résolu(e)
Microsoft 365 Copier/coller - Ajout/suppression lignes automatiques
Réponses
6
Affichages
889
M.Ben
M
N
  • Question Question
XL 2019 Lier deux fichiers pour traitements de données sur Excel et ou google sheets
Réponses
0
Affichages
455
nhaeliko
N
C
  • Question Question
Microsoft 365 VBA-Comparaison de données
Réponses
4
Affichages
781
CyrilTD
C
L
  • Question Question
Power Query groupés deux tableaux qui existent sur la même feuille et ajout d'information supplémentaire
Réponses
7
Affichages
873
Aurelili
A
oguruma
POWERQUERY :: Importer un fichier .csv avec construction de critères dynamiques (5 max) de type texte et sélection entre deux dates possible - V2.0
Réponses
0
Affichages
371
oguruma
oguruma
D
  • Question Question
Microsoft 365 macro suppression de lignes dans un tableau
Réponses
3
Affichages
607
Hasco
Hasco
L
  • Question Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
822
fanfan38
fanfan38
Retour