Comparer 2 tableaux

Chris57

XLDnaute Occasionnel
Bonjour à tous,

Au boulot, dans un tableau d'environ 9000 lignes nous cochons certaines de ces lignes (un simple x dans la cellule voisine) puis par macro les lignes cochées sont copiées dans une autre feuille.
Puis cette autre feuille est copiée dans un classeur vierge puis sauvegardée.

Maintenant nous aimerions faire le chemin inverse :
à partir de la liste sauvegardée nous voudrions recocher les bonnes cases dans le tableau initial.

J'ai donc écrit ceci :
Code:
For Each x In Sheets("Gamme A4").[E10:E700]
    If x <> "" Then ORGANErecherche = x
            For Each y In Sheets("LISTE DES ORGANES").[C5:C9000]
                If x = y Then
                y.Offset(0, -2) = "X"
                End If
            Next y
Next x

Mais c'est extrèmement long !! Même en partant d'une liste sauvegardée de 16 lignes, il lui faut 5 minutes pour recocher les lignes correspondantes dans le grand tableau...

Y a t'il moyen d'accélérer ça ?
 

Chris57

XLDnaute Occasionnel
Re : Comparer 2 tableaux

Le fichier d'origine fait près de 2Mo donc impossible à poster.
Mais en gros il n'y a rien de spécial.

Voici un fichier exemple avec une liste raccourcie.
 

Pièces jointes

  • Générateur.xlsm
    36 KB · Affichages: 93
  • Générateur.xlsm
    36 KB · Affichages: 101
  • Générateur.xlsm
    36 KB · Affichages: 100

Paritec

XLDnaute Barbatruc
Re : Comparer 2 tableaux

Re bonjour Chris,
bon alors après avoir ouvert les yeux, j'ai vu ou tu voulais la croix!!!! (pas bien réveillé le monsieur)
alors voilà qui va changer la donne pour la vitesse
a+
papou :eek:

VB:
Sub RECOCHER_organes()
    Dim i&, fin&, fin1, aa As Variant, bb As Variant, a&
    fin = Sheets("Gamme A4").Range("E65536").End(xlUp).Row
    fin1 = Sheets("LISTE DES ORGANES").Range("C65536").End(xlUp).Row
    aa = Sheets("Gamme A4").Range("E11:E" & fin)
    bb = Sheets("LISTE DES ORGANES").Range("A2:C" & fin1)
    For i = 1 To UBound(aa)
        For a = 1 To UBound(bb)
            If aa(i, 1) = bb(i, 3) Then bb(i, 1) = "X": GoTo 1
        Next a
1    Next i
    Sheets("LISTE DES ORGANES").Range("A2").Resize(UBound(bb)) = bb
End Sub
 
Dernière édition:

soenda

XLDnaute Accro
Re : Comparer 2 tableaux

Bonjour le fil, Chris57, Paritec

Sur la base du code de Paritec et si l'on admet que les listes sont triées par ordre croissant, on peut accélérer un peu, comme suit.

Si c'est encore trop lent, on pourra essayer avec une recherche dichotomique (toujours avec des listes triées)

Code:
Sub RECOCHER_organes()
    Dim i&, fin&, fin1, aa As Variant, bb As Variant, a&
 
dim debut&
Dim ch$
 
    fin = Sheets("Gamme A4").Range("E65536").End(xlUp).Row
    fin1 = Sheets("LISTE DES ORGANES").Range("C65536").End(xlUp).Row
    aa = Sheets("Gamme A4").Range("E11:E" & fin)
    bb = Sheets("LISTE DES ORGANES").Range("A2:C" & fin1)
 
debut = 1
    For i = 1 To UBound(aa)
 
ch=aa(i)
 
        For a = debut To UBound(bb)
            If bb(a, 3) = ch Then
 
bb(a, 1) = "X"
debut = a + 1
exit for
end if
 
        Next a
     Next i
 
    Sheets("LISTE DES ORGANES").Range("A2").Resize(UBound(bb)) = bb
End Sub
A plus :)
 

Paritec

XLDnaute Barbatruc
Re : Comparer 2 tableaux

Bonjour Soenda, Chris57 le forum
Soenda Chris parle de 5 minutes pour 16 lignes, avec les tableaux les 10000 lignes c'est moins de 0,2 secondes, et vu la définition du problème je serais surpris que les listes soient classées, alors si de 5 minutes à 0,2 seconde cela ne suffit pas effectivement là je ne sais pas faire moi.
bon week-end
Papou :eek:
 

Paritec

XLDnaute Barbatruc
Re : Comparer 2 tableaux

Bonsoir Jean Marcel:eek: soenda chris
bon alors OK Jean Marcel tu as raison mon résultat était faux et pour cause
mais lors de ta demande je n'avais pas compris!!!! excuses
j'avais mis un i à la place d'un a revoilà la bonne macro !!!!
a+
papou :eek:
VB:
Sub RECOCHER_organes()
    Dim i&, fin&, fin1, aa As Variant, bb As Variant, a&
    fin = Sheets("Gamme A4").Range("E65536").End(xlUp).Row
    fin1 = Sheets("LISTE DES ORGANES").Range("C65536").End(xlUp).Row
    aa = Sheets("Gamme A4").Range("E11:E" & fin)
    bb = Sheets("LISTE DES ORGANES").Range("A2:C" & fin1)
    For i = 1 To UBound(aa)
        For a = 1 To UBound(bb)
            If aa(i, 1) = bb(a, 3) Then bb(a, 1) = "X": GoTo 1
        Next a
1    Next i
    Sheets("LISTE DES ORGANES").Range("A2").Resize(UBound(bb)) = bb
End Sub
 
Dernière édition:

Chris57

XLDnaute Occasionnel
Re : Comparer 2 tableaux

Bonjour à tous et merci pour votre aide,
effectivement la liste n'est pas classé par ordre croissante mais par circuits (les codes que vous voyez sont le nom de pompes, vannes et autre éléments).

J'ai donc testé ta macro, Paritec, mais étrangement elle s'arrête après quelques éléments.
J'ai fait un test avec une liste sauvegardée de 20 éléments, mais la macro n'en coche que 18 cases dans la grande liste....
Avec une autre liste de 9 éléments, elle n'en coche que 7...

j'y comprends rien !!
 
Dernière édition:

Si...

XLDnaute Barbatruc
Re : Comparer 2 tableaux

Salut

à tester (liste sans doublon)
Code:
Sub RECOCHER_organes()
  Dim Cel As Range, C As Range
  With Sheets("LISTE DES ORGANES")
    .[A:A].ClearContents
    For Each Cel In Sheets("Gamme A4").[E10:E9000].SpecialCells(xlCellTypeConstants)
      Set C = .[C:C].Find(Cel)
      If Not C Is Nothing Then .Cells(C.Row, 1) = "X"
    Next
  End With
End Sub
 

Chris57

XLDnaute Occasionnel
Re : Comparer 2 tableaux

Rectification, j'ai compris : il arrive que dans la liste il y a 2 organes qui portent le même code.
Et il ne va que cocher l'un des 2, ce qui est normal.

Ce qui fait la différence entre ces 2 organes se situe dans la colonne G de la save et dans la colonne N dans la grande liste (voir fichier joint qui donne un exemple)

Peut-on règler ce soucis ?
 

Pièces jointes

  • Générateur.xlsm
    43.8 KB · Affichages: 67
  • Générateur.xlsm
    43.8 KB · Affichages: 76
  • Générateur.xlsm
    43.8 KB · Affichages: 74

Paritec

XLDnaute Barbatruc
Re : Comparer 2 tableaux

Bonsoir Chris, Soenda:eek:, Jean Marcel:eek:, si
alors oui si tu as plusieurs critères à respecter il fallait le dire !!!
ton fichier en retour
voilà qui devrait régler le problème, mais attention si tu as des références en double il faudra retirer :goto 1 et le 1 car il ne sont là que pour gagner du temps, mais interdisent de cocher 2 fois.
regardes teste et redis nous
a+
papou :eek:
 

Pièces jointes

  • Chris57V3.xlsm
    44.2 KB · Affichages: 81
Dernière édition:

Chris57

XLDnaute Occasionnel
Re : Comparer 2 tableaux

En fait j'avais totalement oublié qu'il pouvait y avoir des doublons dans la colonne C...

Mais là ça fonctionne à merveille !! J'ai testé un liste de 101 éléments prélevés : 0,28 secondes pour effectuer la recherche inverse ! Bref le top !!

Mes collègues et moi même te remercions !!!!!!
 

Discussions similaires

Réponses
2
Affichages
153
Réponses
1
Affichages
168