Tri automatique

[zouzou76190]

Bonjour à tous,

J'aurais besoin de vos conseil pour réaliser le tri dans un tableau excel.

En fait, je voudrais qu'Excel vérifie si les valeur comprisent dans la colonne 1 de la feuille 2 sont présentent dans la colonne 1 de la feuille 1.

Il faudrait que les lignes (colonne 1, 2 et 3) de la feuille 2 qui ne sont pas présente se recopient dans la feuille 1
toutes seules tout en gardant le tri alphabétique de la colonne 1.



Merci d'avance

 

[job75]

Re : Tri automatique

Bonjour zouzou76190,

Dans votre exemple toutes les lignes de Feuil1 sont en Feuil2.

Si c'est toujours le cas, il suffit de copier Feuil2 sur Feuil1 puis de trier :

Private Sub Worksheet_Activate()
'Feuil2 est le CodeName de la 2ème feuille
Feuil2.[A:C].Copy [A1]
[A:C].Sort [A1], Header:=xlYes 'tri
End Sub

La macro est à placer dans le code de Feuil1 (clic droit sur l'onglet et Visualiser le code).

Elle s'exécute quand on active Feuil1.

Edit : le fichier doit être enregistré sous .xlsm (acceptant les macros).

A+

 

[job75]

Re : Tri automatique

Re,

Si toutes les lignes de Feuil1 ne sont pas en Feuil2 :

Private Sub Worksheet_Activate()
'Feuil2 est le CodeName de la 2ème feuille
Dim c As Range, ajout As Range
For Each c In Feuil2.Range("A2", Feuil2.Range("A" & Rows.Count).End(xlUp))
  If IsError(Application.Match(c, [A:A], 0)) Then _
    Set ajout = Union(c.Resize(, 3), IIf(ajout Is Nothing, c.Resize(, 3), ajout))
Next
If Not ajout Is Nothing Then _
    ajout.Copy Range("A" & Rows.Count).End(xlUp)(2)
[A:C].Sort [A1], Header:=xlYes 'tri
End Sub

A+

 

[job75]

Re : Tri automatique

Re,

Toujours dans le cas où des lignes de Feuil1 n'existent pas en Feuil2, cette solution est beaucoup plus rapide sur de grands tableaux :

Private Sub Worksheet_Activate()
'Feuil2 est le CodeName de la 2ème feuille
Dim t1, t2, d As Object, i As Long
t1 = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row)
t2 = Feuil2.Range("A2:C" & Feuil2.Range("A" & Rows.Count).End(xlUp).Row)
If t2(UBound(t2), 1) = "" Then Exit Sub 'si le 2ème tableau est vide
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t1)
  d(t1(i, 1)) = ""
Next
For i = 1 To UBound(t2)
  If d.exists(t2(i, 1)) Then
    t2(i, 1) = ""
    t2(i, 2) = ""
    t2(i, 3) = ""
  End If
Next
[A2:C2].Offset(UBound(t1)).Resize(UBound(t2)) = t2
[A:C].Sort [A1], Header:=xlYes 'tri
End Sub

En effet elle utilise l'objet "Dictionary" et des tableaux VBA (matrices).

A+