XL 2016 Debogage VBA

[zoubir15]

bonjour,

J'ai une deboge dans le fichier je ne sais pas avant il fonctionné bien

Merci d'avance

Sub ComparerListes()
Dim TSrcA(), TSrcB(), L&, TRés(1 To 1000, 1 To 3), TL(1 To 3) As Long, Élément As SsGroup, Où As Long, Détail
TSrcA = Feuil1.[A2].Resize(Feuil1.[A10000000].End(xlUp).Row - 1).Value
TSrcB = Feuil1.[B2].Resize(Feuil1.[B10000000].End(xlUp).Row - 1).Value
For L = 1 To UBound(TSrcA, 1): TSrcA(L, 1) = Replace(TSrcA(L, 1), " ", ""): Next L
For L = 1 To UBound(TSrcB, 1): TSrcB(L, 1) = Replace(TSrcB(L, 1), " ", ""): Next L
Feuil1.[A2].Resize(UBound(TSrcA, 1)).Value = TSrcA
Feuil1.[B2].Resize(UBound(TSrcB, 1)).Value = TSrcB
For Each Élément In GroupOrg(TableUnique(TSrcA, TSrcB), 1)
Où = 0
For Each Détail In Élément.Contenu
Où = Où Or 2 ^ Détail(0): Next Détail
Où = Choose(Où, 2, 3, 1)
TL(Où) = TL(Où) + 1: TRés(TL(Où), Où) = Élément.Id
Next Élément
Feuil1.[C2:E1001].Value = TRés

 

[cp4]

bonjour,

J'ai une deboge dans le fichier je ne sais pas avant il fonctionné bien

Merci d'avance

Sub ComparerListes()
Dim TSrcA(), TSrcB(), L&, TRés(1 To 1000, 1 To 3), TL(1 To 3) As Long, Élément As SsGroup, Où As Long, Détail
TSrcA = Feuil1.[A2].Resize(Feuil1.[A10000000].End(xlUp).Row - 1).Value
TSrcB = Feuil1.[B2].Resize(Feuil1.[B10000000].End(xlUp).Row - 1).Value
For L = 1 To UBound(TSrcA, 1): TSrcA(L, 1) = Replace(TSrcA(L, 1), " ", ""): Next L
For L = 1 To UBound(TSrcB, 1): TSrcB(L, 1) = Replace(TSrcB(L, 1), " ", ""): Next L
Feuil1.[A2].Resize(UBound(TSrcA, 1)).Value = TSrcA
Feuil1.[B2].Resize(UBound(TSrcB, 1)).Value = TSrcB
For Each Élément In GroupOrg(TableUnique(TSrcA, TSrcB), 1)
Où = 0
For Each Détail In Élément.Contenu
Où = Où Or 2 ^ Détail(0): Next Détail
Où = Choose(Où, 2, 3, 1)
TL(Où) = TL(Où) + 1: TRés(TL(Où), Où) = Élément.Id
Next Élément
Feuil1.[C2:E1001].Value = TRés

Bonjour,
Il me semble reconnaitre la marque de fabrique de @Dranreb 😊.
Je reviendrais si je trouve une solution😉

 

[M12]

Bonjour,
Déjà, une erreur dans les deux lignes

TSrcA = Feuil1.[A2].Resize(Feuil1.[A10000000].End(xlUp).Row - 1).Value
TSrcB = Feuil1.[B2].Resize(Feuil1.[B10000000].End(xlUp).Row - 1).Value

Je ne pense pas qu'excel eu 10.000.000 lignes
le max de mon côté c'est 1.048.576

 

[Bernard_XLD]

Bonjour zoubir15, cp4, le forum

Où = Où Or 2 ^ Détail(0)

et cette ligne ne veut rien dire, Où est toujours égal à Où et la deuxième condition 2 ^ Détail(0) n'est pas définie, la boucle ne sert à rien.
Pour citer Coluche dans le "qui perd perd", "Quelle est la différence entre un pigeon ?"

Cordialement, @+

 

[Dranreb]

Bonjour.
Ah si: ça met à 1, dans Où (As Long), le bit de rang donné par Détail(0)
Les opérateurs logiques travaillent bit par bit. Bien sûr pour des Boolean ça ne se voit pas parce que True a tous ses bits à 1 (c'est pour ça que traduit en entier le True de VBA vaut -1, tandis que le VRAI d'Excel, fondé sur une autre principe vaut 1) et False, à 0.
Et Détail est un variant contenant un tableau d'une ligne dont l'élément 0 contient le numéro d'ordre à partir de 0 de la table source dont il provient. Cette instruction élabore donc un code indiquant sa présence possible dans les deux sources : 1 dans la 1ère, 2 dans la seconde et 3 dans les deux.

Curieux, je ne retrouve pas ce classeur dans mes archives …
Ah si j'avais mal regardé.

Après enregistrement pour pouvoir exécuter la macro il s'avère que le plantage vient d'un nombre insuffisant de lignes dans la déclaration de TRés(1 To 1000, 1 To 3). Augmentez ces 1000.

Remarque: c'est un vieux truc. Je n'utilise plus GroupOrg ni TableIndex. À la place c'est devenu une fonction appelée Gigogne.

Et oui, je confirme, il y a d'abord une erreur sur le numéro de ligne maxi possible. Dans le classeur d'origine c'était 1000000.

 

[Bernard_XLD]

Bonjour dranreb

Ah si: ça met à 1, dans Où (As Long), le bit de rang donné par Détail(0)

merci de cette précision, je vais regarder plus en détail car je ne comprends pas comment cette instruction fonctionne. J'ai plutôt pensé que le code d'origine avait été mal modifié comme c'était le cas pour les lignes.

Bonne continuation
Cordialement, @+

 

[cp4]

Bonjour @zoubir15 😵, @M12 😉, @Dranreb 😉, @Bernard_XLD 😉,

@zoubir15 : Il n'y a pas de plus énervant lorsqu'on pose une question et on s'éclipse. J'ai remarqué que beaucoup de membres surtout les nouveaux se sont inscrit pour des prestations de services gratuites. Or, XLD a été créé dans un but d'échange et d'entraide.
Depuis mon inscription j'ai beaucoup appris et j'apprends encore jusqu'à cette heure. Je n'ai pas encore atteint le niveau comme celui de Dranreb. D'ailleurs, le code que je te proposerais et une adaptation de feu Jacques Boisgontier.
Zoubir15, Si le code t’intéresses manifeste-toi.

 

[zoubir15]

Merci Monsieur,

Pour ton temps et réponse. oui le code m'intéresse beaucoup.

Merci mes salutations.

 

[cp4]

Merci Monsieur,

Pour ton temps et réponse. oui le code m'intéresse beaucoup.

Merci mes salutations.

@zoubir15 : Stp, sur ce forum on se tutoie, donc Monsieur n'a pas sa place.
Vu le grand nombre de lignes, je n'ai pas vérifié si les codes donnent les résultats attendus.
Même pour toi ça sera difficile, il faudrait réduire le nombre de lignes pour la vérification de l'exactitude des résultats.
Ton fichier en retour, il suffit de cliquer sur le bouton (les plages recevant les résultats sont vidées par code).
A+ pour nous dire si c'est bon.

 

[zoubir15]

@zoubir15 : Stp, sur ce forum on se tutoie, donc Monsieur n'a pas sa place.
Vu le grand nombre de lignes, je n'ai pas vérifié si les codes donnent les résultats attendus.
Même pour toi ça sera difficile, il faudrait réduire le nombre de lignes pour la vérification de l'exactitude des résultats.
Ton fichier en retour, il suffit de cliquer sur le bouton (les plages recevant les résultats sont vidées par code).
A+ pour nous dire si c'est bon.

Merci @cp4

Dommage pour Extraies les données qui sont dans A et pas dans B donne résultat faux.
je ne sais pas pourquoi.

Merci

 

[cp4]

Merci @cp4

Dommage pour Extraies les données qui sont dans A et pas dans B donne résultat faux.
je ne sais pas pourquoi.

Merci

Joindre un fichier avec peu de données et monter manuellement le résultat attendu.
A+

 

[laurent950]

Bonsoir,

@Dranreb à raison
soit le fichier excel qui a 1048576 ligne pour TSrcA et TSrcB
puis pour être en accord le tableau TRés aura aussi 1048576 cases réservés

Option Explicit
Sub ComparerListes()
Dim TSrcA(), TSrcB(), L&, TRés(1 To 1048576, 1 To 3), TL(1 To 3) As Long, Élément As SsGroup, Où As Long, Détail
TSrcA = Feuil1.[A2].Resize(Feuil1.[A1048576].End(xlUp).Row - 1).Value
TSrcB = Feuil1.[B2].Resize(Feuil1.[B1048576].End(xlUp).Row - 1).Value
For L = 1 To UBound(TSrcA, 1): TSrcA(L, 1) = Replace(TSrcA(L, 1), " ", ""): Next L
For L = 1 To UBound(TSrcB, 1): TSrcB(L, 1) = Replace(TSrcB(L, 1), " ", ""): Next L
Feuil1.[A2].Resize(UBound(TSrcA, 1)).Value = TSrcA
Feuil1.[B2].Resize(UBound(TSrcB, 1)).Value = TSrcB
For Each Élément In GroupOrg(TableUnique(TSrcA, TSrcB), 1)
  Où = 0
  For Each Détail In Élément.Contenu
     Où = Où Or 2 ^ Détail(0): Next Détail
  Où = Choose(Où, 2, 3, 1)
  TL(Où) = TL(Où) + 1: TRés(TL(Où), Où) = Élément.Id
  Next Élément
Feuil1.[C2:E1001].Value = TRés
End Sub

 

[cp4]

Bonsoir,

@Dranreb à raison
soit le fichier excel qui a 1048576 ligne pour TSrcA et TSrcB
puis pour être en accord le tableau TRés aura aussi 1048576 cases réservés

Option Explicit
Sub ComparerListes()
Dim TSrcA(), TSrcB(), L&, TRés(1 To 1048576, 1 To 3), TL(1 To 3) As Long, Élément As SsGroup, Où As Long, Détail
TSrcA = Feuil1.[A2].Resize(Feuil1.[A1048576].End(xlUp).Row - 1).Value
TSrcB = Feuil1.[B2].Resize(Feuil1.[B1048576].End(xlUp).Row - 1).Value
For L = 1 To UBound(TSrcA, 1): TSrcA(L, 1) = Replace(TSrcA(L, 1), " ", ""): Next L
For L = 1 To UBound(TSrcB, 1): TSrcB(L, 1) = Replace(TSrcB(L, 1), " ", ""): Next L
Feuil1.[A2].Resize(UBound(TSrcA, 1)).Value = TSrcA
Feuil1.[B2].Resize(UBound(TSrcB, 1)).Value = TSrcB
For Each Élément In GroupOrg(TableUnique(TSrcA, TSrcB), 1)
  Où = 0
  For Each Détail In Élément.Contenu
     Où = Où Or 2 ^ Détail(0): Next Détail
  Où = Choose(Où, 2, 3, 1)
  TL(Où) = TL(Où) + 1: TRés(TL(Où), Où) = Élément.Id
  Next Élément
Feuil1.[C2:E1001].Value = TRés
End Sub

Bonsoir Laurent950 😉 ,

@laurent950 : Content de te croiser, cela fait un bon moment!
Bonne soirée.

 

[Dranreb]

Le mieux serait sans doute de ne pas le dimensionner à la déclaration, juste TRés() et un peu plus loin Redim TRés(1 To WorksheetFunction.Max(UBound(TSrcA, 1), Ubound(TSrcB, 1)), 1 To 3)
Mais ça commence à faire un peu beaucoup de UBound(TSrc… Je les déterminerais peu être une seule fois dans des variables LMaxA et LMaxB

 

[cp4]

Merci @cp4

Dommage pour Extraies les données qui sont dans A et pas dans B donne résultat faux.
je ne sais pas pourquoi.

Merci

@zoubir15 : désolé, j'ai fait une grossière erreur due au copier/coller. Code ci-dessous corrigé.

Sub Dans_A_pas_dans_B() 'Liste1_Liste2()
A = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
Set MonDico1 = CreateObject("Scripting.Dictionary")
For Each C In A
If Not MonDico1.exists(C) Then MonDico1.Add C, C
Next C
B = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each C In B
If Not MonDico1.exists(C) Then If Not MonDico2.exists(C) Then MonDico2.Add C, C
Next C
Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row).ClearContents
[D2].Resize(MonDico2.Count, 1) = Application.Transpose(MonDico2.items)
End Sub

edit: Bonsoir @Dranreb 😉