comparaison et extraction listes

[ivan27]

Bonsoir à tous,
J’ai un petit problème de comparaison et extraction dans des listes.
Feuil1, une liste de prise de carburant pouvant atteindre plusieurs milliers de lignes.
Feuil2, la même liste provenant d’une source différente.
Il s’agit de comparer les listes de ces deux feuilles sur la feuil3 afin de lister :
- Données communes aux feuilles 1 et 2
- Données de la feuille 1 absentes sur la feuille 2
- Données de la feuille 2 absentes sur la feuille 1
Une spécificité concernant la comparaison, les arrondis de litrage peuvent différer sur les deux feuilles. (Par exemple le chiffre 234,40 sur la feuille1 peut très bien être noté 234 ou 235 sur la feuille2).
Je n’ai pas trouvé d’exemple avec 3 critères (DATE, IMMATRICULATION, LITRE)
Mon fichier exemple comprend des données en feuilles 1 et 2 et les résultats attendus sur la feuille 3.
Merci d’avance pour vos suggestions,
Ivan

 

[BOISGONTIER]

Re : comparaison et extraction listes

Bonjour,

Voir PJ

0,5 s pour 3.000 lignes

http://boisgontierjacques.free.fr/fichiers/Cellules/Comparaison2BD2Num.xls

Sub Communs()
  Application.ScreenUpdating = False
  Set f1 = Sheets("BD1")
  Set f2 = Sheets("BD2")
  a = f1.Range("A1").CurrentRegion.Value
  b = f2.Range("A1").CurrentRegion.Value
  Set mondico1 = CreateObject("Scripting.Dictionary")
  For i = 2 To UBound(a)
    clé = a(i, 1) & a(i, 3) & Int(a(i, 7))
    mondico1(clé) = a(i, 7)
    clé = a(i, 1) & a(i, 3) & Int(a(i, 7)) + 1
    mondico1(clé) = a(i, 7)
    clé = a(i, 1) & a(i, 3) & Int(a(i, 7)) - 1
    mondico1(clé) = a(i, 7)
  Next i
  ligne = 1
  Dim c
  ReDim c(1 To Application.Max(UBound(a), UBound(b)), 1 To 6)
  For i = 2 To UBound(b)
    clé = b(i, 5) & b(i, 2) & Int(b(i, 7))
    If mondico1.Exists(clé) Then
       c(ligne, 1) = b(i, 5)
       c(ligne, 2) = b(i, 2)
       c(ligne, 3) = b(i, 11)
       c(ligne, 4) = b(i, 4)
       c(ligne, 5) = b(i, 7)
       c(ligne, 6) = mondico1(clé)
       ligne = ligne + 1
    End If
  Next
  Sheets("Resultats").[A4].Resize(UBound(c, 1), UBound(c, 2)) = c
  Sheets("Resultats").[A4].Resize(UBound(c, 1)) = Application.Index(c, , 1)  'dates
End Sub

JB
Formation Excel VBA JB

 

[Bebere]

Re : comparaison et extraction listes

bonjour Ivan,Jacques
une autre
rmq pour avoir un résultat j'ai du copier les données feuil2 dans une nouvelle feuille
code dans module1

 

[ivan27]

Re : comparaison et extraction listes

Bonjour à tous,

Merci Jacques, Bebere pour le travail accompli.
Question complèmentaire SVP. Quelles sont les données à modifier dans vos codes respectifs pour faire varier la marge d'erreur concernant le litrage entre les feuilles 1 et 2
Par exemple, si dans la feuille 2 j'ai 506,40 litres et je souhaite dire que cette valeur est = à 500/510 litres dans la feuille 1
Cordialement,

Ivan

 

[BOISGONTIER]

Re : comparaison et extraction listes

Voir PJ

JB

 

[Bebere]

Re : comparaison et extraction listes

Ivan

'ligne existante
If tbl1(L1, 7) = tbl2(L2, 7) Or Application.RoundUp(tbl1(L1, 7), 0) = tbl2(L2, 7) Or Int(tbl1(L1, 7)) = tbl2(L2, 7) Then
'nouvelle ligne.marge de 1 ex:200,2 prend de 200 à 201
If tbl1(L1, 7) = tbl2(L2, 7) Or tbl2(L2, 7) >= Int(tbl1(L1, 7)) And tbl2(L2, 7) <= Application.RoundUp(tbl1(L1, 7), 0) Then

le code de Jacques est plus rapide pour des données plus importantes
j'ai appris quelque chose aujourdhui
à bientôt

 

[ivan27]

Re : comparaison et extraction listes

Merci Jacque & Bebere,

Réponses rapides et complètes....

Cdlt,

Ivan

 

[ivan27]

Re : comparaison et extraction listes

Bonsoir à tous,

Les codes communiqués par Jacques sont excellents mais j'aurais encore besoin d'une "petite" amélioration :
J'ai rajouté une feuille intitulée "liste".
Je souhaiterais que : Si BD1 ou BD2 contient des éléments de cette liste, les lignes concernées ne soient pas importées dans résultat.
Merci d'avance pour vos recherches.
Ivan

 

[BOISGONTIER]

Re : comparaison et extraction listes

Bonjour,

Voir PJ

JB

 

[ivan27]

Re : comparaison et extraction listes

Merci Jacques,

L'extraction correspond exactement à ce que je souhaitais.
Cdlt,
Ivan