Macro de comparaison de deux tableaux très très lente

Le 27/03/2016 à 23:30

Bonjour, Je suis débutant sur VBA. Je travaille sur un projet VBA afin de comparer deux tableau. Le principe c'est de voir si les dépenses enregistre dans le compte 185 et sont dans le 181. Avec le macro que je fais, J'arrive à mettre en couleur vert les écritures enregistre dans le deux comptes mais ma macro est trop lente (30 min à 1 heure). De plus, il ne permet pas de détecter les doublons et les écritures scinder. Merci d'avance pour votre aide. Je rester à votre disposition pour toute question. Voilà mes deux macros de débutant, j'aimere bien avoir une seule macro et gagner du temps à l’exécution.

Sub ComparerDeuxTabls()

Dim tabl1 As Range

Dim tabl2 As Range

Dim i As Integer, j As Integer, y As Integer, z As Integer

Set tabl1 = Application.InputBox("Veuillez sélectionner la première tabl.", Type:=8)

Set tabl2 = Application.InputBox("Veuillez sélectionner la deuxième tabl.", Type:=8)

For i = 1 To tabl1.Rows.Count

Ci-joint le fichier.

For j = 1 To tabl2.Rows.Count

For y = 1 To tabl1.Columns.Count

For z = 1 To tabl2.Columns.Count

If Month(tabl1(i, 2).Value) & tabl1(i, 8).Value - tabl1(i, 7).Value = Month(tabl2(j, 2).Value) & tabl2(j, 7).Value - tabl2(j, 8).Value Then

tabl1(i, y).Interior.Color = 5287936

tabl2(j, z).Interior.Color = 5287936

End If

Next z

Next y

Next j

Next i

End Sub

Sub Doublon()

Dim tabl1 As Range

Dim tabl2 As Range

Dim i As Integer, j As Integer, y As Integer, z As Integer

Set tabl1 = Application.InputBox("Veuillez sélectionner la première tabl.", Type:=8)

Set tabl2 = Application.InputBox("Veuillez sélectionner la deuxième tabl.", Type:=8)

For i = 1 To tabl1.Rows.Count

For j = 1 To tabl2.Rows.Count

If Month(tabl1(i, 2).Value) & tabl1(i, 8).Value - tabl1(i, 7).Value = Month(tabl1(i + 1, 2).Value) & tabl1(i + 1, 8).Value - tabl1(i + 1, 7).Value And Month(tabl1(i, 2).Value) & tabl1(i, 8).Value - tabl1(i, 7).Value = Month(tabl2(j, 2).Value) & tabl2(j, 7).Value - tabl2(j, 8).Value Then

tabl1(i, 1).Interior.Color = xlNone

tabl1(i + 1, y).Interior.Color = xlNone

tabl2(j, z).Interior.Color = xlNone

End If

Next j

Next i

End Sub

33texte-compte-de-liaison.xlsm (259.86 Ko)
Le 27/03/2016 à 23:47

Salut Drogba,

on veut tous bien t'aider mais, là, en tout cas pour moi, c'est du mandarin!

Tes deux feuilles, sauf erreur, sont identiques! Que faut-il comparer? Dans quelles colonnes? Où faut-il afficher les résultats? Comment?

Sois plus concret! Nous, on débarque dans ton monde qui nous est inconnu!

A+

Le 28/03/2016 à 00:55

Merci Curulis57.

Je recherche à comprendre la cause de l'écart entre le solde du compte 181 ( Tableau 1 ici colonne P à X) et Le solde du compte 185 ( tableau 2 ici Colonne A à I). La macro que je mis en place me permet de sectionner mes tableaux, puis de mettre en couleur vert les lignes identiques que je retrouve dans les deux tableaux. les lignes sans couleur sont la cause de l'écart. Pour faire cette comparaison je regarde la date notamment le mois, le montant en débit et en crédit des lignes du tableau 1 et je le compare au second tableau 2. le souci et que ma macro ( Module 1) prends du temps. Avec le code ci-dessous j'arrive à le faire sans prendre en compte les doublons c'est à dire une ligne identique dans le même tableau soit un doublon mais qui apparaît qu'une fois dans le second tableau ne dois pas être en vert d'ou ma module 2.

La module 1 du fichier précédemment joint fait la même chose que le code ci-dessous très long qui est plus rapide dans l'exécution. J'ai juste raccourci le code mais la macro est devenu très lent.

Svp aidez-moi

Sud

Dim tabl1 As Range

Dim tabl2 As Range

Set tabl1 = Application.InputBox("Veuillez sélectionner la première tabl.", Type:=8)

Set tabl2 = Application.InputBox("Veuillez sélectionner la deuxième tabl.", Type:=8)

For i = 1 To tabl1.Rows.Count

For j = 1 To tabl2.Rows.Count

If tabl1(i, 2).Value & tabl1(i, 8).Value - tabl1(i, 8).Value = tabl2(j, 2).Value & tabl2(j, 7).Value - tabl2(j, 8).Value Then

tabl1(i, 1).Interior.Color = 5287936

tabl2(j, 1).Interior.Color = 5287936

tabl1(i, 2).Interior.Color = 5287936

tabl2(j, 2).Interior.Color = 5287936

tabl1(i, 3).Interior.Color = 5287936

tabl2(j, 3).Interior.Color = 5287936

tabl1(i, 4).Interior.Color = 5287936

tabl2(j, 4).Interior.Color = 5287936

tabl1(i, 5).Interior.Color = 5287936

tabl2(j, 5).Interior.Color = 5287936

tabl1(i, 6).Interior.Color = 5287936

tabl2(j, 6).Interior.Color = 5287936

tabl1(i, 7).Interior.Color = 5287936

tabl2(j, 7).Interior.Color = 5287936

tabl1(i, 8).Interior.Color = 5287936

tabl2(j, 8).Interior.Color = 5287936

tabl1(i, 9).Interior.Color = 5287936

tabl2(j, 9).Interior.Color = 5287936

End If

Next j

Next i

End Sub

Le 28/03/2016 à 01:49

Sans doute trop tard pour réfléchir à ça...

Demain est un autre jour!

A+

Le 28/03/2016 à 13:03

Bonjour,

à tester, devrait amméliorer quelque peu le temps d'exécution

Dim tabl1 As Range
Dim tabl2 As Range
application.screenupdating=false
Set tabl1 = Application.InputBox("Veuillez sélectionner la première tabl., ne pas prendre les entêtes", Type:=8)
Set tabl2 = Application.InputBox("Veuillez sélectionner la deuxième tabl.ne pas prendre les entêtes", Type:=8)
dl1=tabl1.cells(rows.count,1).end(xlup).row
dl2=tabl2.cells(rows.count,1).end(xlup).row
For i = 1 To dl1
   For j = 1 To dl2
      If tabl1(i, 2).Value & tabl1(i, 8).Value - tabl1(i, 8).Value = tabl2(j, 2).Value & tabl2(j, 7).Value - tabl2(j, 8).Value Then
         tabl1.rows(i).Interior.Color = 5287936
         tabl2.rows(j).Interior.Color = 5287936
     End If
  Next j
Next i
application.screenupdating=true
Le 28/03/2016 à 15:36

Bonjour h2so4,

Je teste la macro, mais elle ne marche pas.

Je n'arrive pas à l'exécute. Voilà ci-joint le fichier excel.

Le module 1 et module 2 sont les macros que je fais.

Le module 3 est la macro que tu vient de m'envoyer.

Merci d'avance.

36texte-compte-de-liaison.xlsm (278.61 Ko)
Le 28/03/2016 à 18:21

Bonjour,

une correction

Sub macroteste()
Dim tabl1 As Range
Dim tabl2 As Range

Set tabl1 = Application.InputBox("Veuillez sélectionner les colonnes de la première tabl", Type:=8)
Set tabl2 = Application.InputBox("Veuillez sélectionner les colonnes de la deuxième tabl", Type:=8)
Application.ScreenUpdating = False
dl1 = tabl1.Cells(Rows.Count, 1).End(xlUp).Row
dl2 = tabl2.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To dl1
   For j = 2 To dl2
      If tabl1(i, 2).Value & tabl1(i, 8).Value - tabl1(i, 8).Value = tabl2(j, 2).Value & tabl2(j, 7).Value - tabl2(j, 8).Value Then
         tabl1.Rows(i).Interior.Color = 5287936
         tabl2.Rows(j).Interior.Color = 5287936
     End If
  Next j
Next i
Application.ScreenUpdating = True
End Sub
Le 28/03/2016 à 22:06

Bonsoir H2SO4,

La macro que tu as envoie ne marche toujours pas

Le 29/03/2016 à 10:07

Bonjour

Ma contribution

Je me suis affranchi de la sélection des zones (source d'erreurs) en prenant tout le tableau

Ne connaissant pas le résultat je tente cet essai

Sub ComparerDeuxTabls()
Dim tabl1, tabl2
Dim J As Long, L As Long, Nblg As Long

  Application.ScreenUpdating = False
  Columns("A:T").Interior.ColorIndex = xlNone

  Nblg = Range("A" & Rows.Count).End(xlUp).Row
  With Range("J2:J" & Nblg)
    .FormulaR1C1 = "=MONTH(RC[-8])&""|""&RC[-3]&""|""&RC[-2]"
    tabl1 = .Value
    .ClearContents
  End With

  Nblg = Range("P" & Rows.Count).End(xlUp).Row
  With Range("Y2:Y" & Nblg)
    .FormulaR1C1 = "=MONTH(RC[-8])&""|""&RC[-3]&""|""&RC[-2]"
    tabl2 = .Value
    .ClearContents
  End With

  For J = 1 To UBound(tabl1)
    For L = 1 To UBound(tabl2)
      If tabl1(J, 1) = tabl2(L, 1) Then
        Range("A" & J + 1).Resize(1, 9).Interior.Color = 5287936
        Range("P" & L + 1).Resize(1, 9).Interior.Color = 5287936
      End If
    Next L
  Next J
End Sub
Le 30/03/2016 à 15:43

Bonjour Banzai64,

Merci pour ta grande contribution.

Mais la macro que tu m'as envoyé, ne marche pas.

Le 30/03/2016 à 16:12

Bonjour

Drogba a écrit :

ne marche pas

n'est pas très explicite

ce qu'il faut c'est un fichier avec le résultat (fait manuellement) que l'on doit obtenir automatiquement

Parce que pour moi, suivant tes directives, la macro colore les bonnes lignes

Mais bon j'attends avec impatience ton fichier avec le résultat que tu veux

Le 31/03/2016 à 09:10

Bonjour à tous,

J'ai besoin de votre aide pour finir avec cette Macro svp

Le 31/03/2016 à 10:00
Banzai64 a écrit :

Bonjour

Drogba a écrit :

ne marche pas

n'est pas très explicite

ce qu'il faut c'est un fichier avec le résultat (fait manuellement) que l'on doit obtenir automatiquement

Parce que pour moi, suivant tes directives, la macro colore les bonnes lignes

Mais bon j'attends avec impatience ton fichier avec le résultat que tu veux

Le 31/03/2016 à 15:46

Bonjour d3d9x et Banzai64,

Voilà le fichier joint avec deux feuille. la feuille résultat attendu c'est ce que je veux automatiser et la second feuille ce que la macro fait pour l'instant . Vous pouvez voir la Module 1 dans Visuel basique où j'explique ma macro cette fois ci. Merci pour votre contribution et désolé du retard.

19texte-compte-de-liaison.xlsm (247.81 Ko)
Le 31/03/2016 à 17:40

Bonjour

Mea Culpa

En lisant tes commentaires j'ai vu où est le problème

Si ce n'est pas ça, tu indiques la(es) ligne(s) en faute et le pourquoi de cette(ces) faute(s)

Sub macroteste()
Dim tabl1, tabl2
Dim J As Long, L As Long, Nblg As Long

  Application.ScreenUpdating = False
  Columns("A:X").Interior.ColorIndex = xlNone

  Nblg = Range("A" & Rows.Count).End(xlUp).Row
  With Range("J2:J" & Nblg)
    .FormulaR1C1 = "=MONTH(RC[-8])&RC[-2]-RC[-3]"
    tabl1 = .Value
    .ClearContents
  End With

  Nblg = Range("P" & Rows.Count).End(xlUp).Row
  With Range("Y2:Y" & Nblg)
    .FormulaR1C1 = "=MONTH(RC[-8])&RC[-3]-RC[-2]"
    tabl2 = .Value
    .ClearContents
  End With

  For J = 1 To UBound(tabl1)
    For L = 1 To UBound(tabl2)
      If tabl1(J, 1) = tabl2(L, 1) Then
        Range("A" & J + 1).Resize(1, 9).Interior.Color = 5287936
        Range("P" & L + 1).Resize(1, 9).Interior.Color = 5287936
      End If
    Next L
  Next J
End Sub
Le 01/04/2016 à 09:50

Bonjour Banzai64,

Merci la macro marche très bien pour la première demande c'est à dire trouver les lignes identiques dans le 2 tableau et les mettre en vert. Je sais que je doit rajouter un compteur pour identifier les lignes qui apparaît un nombre de fois supérieur dans l'une de tableau. Exemple cette ligne apparaît 2 fois dans la tabl1 et 1 fois dans la tabl2.

1810000 01/01/15 ANC 1675 A.N. au 010115 63461,01.

Autrement dit dans la tabl1 la plage A2: H2 et la plage A3:H3 sont identiques donc l'écriture revient 2 fois dans la tabl1. Dans la Tabl2 cette écriture n'existe que 1 fois la plage P9:X9. Par conséquence il me faut intégrer un compteur dans la macro pour mettre les lignes en question surlignes en jaune et les écritures en rouge.

Dernière point je ne sais pas comment procédé pour mettre en bleu les écritures scinder c'est à dire le montant de opération a été divisé dans l'une de tableau. IL y'a des exemples des lignes en bleu dans ma feuille résultat attendu ci-joint.

Encore merci à vous pour votre aide.

13texte-compte-de-liaison.xlsm (225.35 Ko)
Le 01/04/2016 à 15:49

Bonjour

Indique moi ce qui fait exactement la similitude entre 2 lignes (Lignes 2 et 3 dans tableau 181 et ligne 9 dans tableau 185)

On prend les mêmes informations que pour la recherche des lignes identiques ?

Pourquoi les lignes 711, 712, 713 (Tableau 181) et les lignes 99 et 591 (Tableau 185) sont en jaune ?

Les colonnes masquées (J à M et Y, Z) sont elles importantes ou je peux les effacer et m'en servir pour la macro

Soit patient car je nage un peu (beaucoup) en ce moment

Le 01/04/2016 à 22:33

Bonsoir Banzai64,

Oui on prend les mêmes informations que pour la recherche des lignes identiques. La similitude entre 2 lignes (Lignes 2 et 3 dans tableau 181 et ligne 9 dans tableau 185 est du à la date, au montant au débit=0 et au crédit= 63461,01).

Les colonnes masquées (J à M et Y, Z) ne sont pas important je peux les effacer.

Les lignes 711, 712 (Tableau 181) correspond aux lignes 99 et 591 (Tableau 185), ils sont en jaune car ils ne sont pas enregistre dans le même mois.

La ligne 713 du tableau 181 n'apparaît pas dans le second tableau 185.

Encore merci pour le temps et le savoir que tu mets à ma disposition.

Le 02/04/2016 à 16:05

Bonjour

A tester au moins pour cette suite

30drogba-comparaison-v003.xlsm (185.69 Ko)
Le 04/04/2016 à 09:17

Bonjour Banzai64,

La dernière version fonction très bien et rapidement.

Merci pour ton aide.

Rechercher des sujets similaires à "macro comparaison deux tableaux tres lente"