XL 2016 Debogage VBA

zoubir15

XLDnaute Junior
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
 

Pièces jointes

  • Copie de GrpOrgZoubir15-rev2.xlsm
    194.8 KB · Affichages: 6

cp4

XLDnaute Barbatruc
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

XLDnaute Accro
Bonjour,
Déjà, une erreur dans les deux lignes
VB:
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
 

Dranreb

XLDnaute Barbatruc
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.
 
Dernière édition:

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
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

XLDnaute Barbatruc
Bonjour @zoubir15 o_O, @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.
Zoubir.gif
 

cp4

XLDnaute Barbatruc
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.
 

Pièces jointes

  • Copie de GrpOrgZoubir15-rev3.xlsm
    236.1 KB · Affichages: 5

zoubir15

XLDnaute Junior
@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
 

laurent950

XLDnaute Accro
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

VB:
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

XLDnaute Barbatruc
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

VB:
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

XLDnaute Barbatruc
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
 
Dernière édition:

cp4

XLDnaute Barbatruc
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é.
VB:
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 ;)
 

Discussions similaires

Réponses
11
Affichages
293
Réponses
12
Affichages
250

Statistiques des forums

Discussions
312 215
Messages
2 086 330
Membres
103 187
dernier inscrit
ebenhamel