Mise en forme VBA, saut de ligne tant que

Bonjour,

Je fais appel à vous car je fais face à un problème.

J'essaye de comparer deux liste l'une en face de l'autre.

Elles comportent les mêmes entrées, si ce n'est que celle de droite est plus complète que celles de gauche (environ 4500 entrées de plus dans la liste de droite sur un total de 33000 entrées environ).

J'essaye de créer une macro qui me permettrait de sauter à gauche le nombre de ligne nécessaire afin que les entrées identiques restent en face entre la liste de gauche et celle de droite.

J'ai créé une macro qui fonctionne jusqu'à la ligne n°70 mais qui dérape en suite. Pouvez vous y jeter un oeil et m'aider ?

Je joins à ma demande mon fichier qui contient ma macro (Macro1), et mon exemple qui fonctionne pour les 70 premières lignes.

Je remets ma macro ici :

Sub Macro1()

Dim I As Long

I = 2

For I = 2 To 32498

If Cells(I, 4) <> Cells(I, 2) Then

Range("A" & I & ":B" & I).Select

Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

End If

Next

End Sub

Merci.

Thomas

7exemple.xlsx (11.42 Ko)

Bonjour,

Vu le temps de traitement, je suis parti sur une solution tableau (array) et dictionary.

quelques questions:

Faut il faire concorder également Point expédition/réception et Division ?

il y a des doublons dans chaque jeu de données (1 pour colonnes A-B, 8 pour D-E) comment les traiter:

ne conserver qu'une occurrence ou pas ?

A+

Une solution sans doublon qui s'exécute en moins d'une seconde :

Sub Aligne()
Dim T1, T2, T3, Dico1,  i as long

Set Dico1 = CreateObject("Scripting.Dictionary")
With Worksheets("Feuil1")
T1 = .Range("A2:B" & .Range("A" & Rows.Count).End(xlUp).Row)
T2 = .Range("D2:E" & .Range("D" & Rows.Count).End(xlUp).Row)

ReDim T3(1 To UBound(T2, 1), 1 To 2)

For i = LBound(T1, 1) To UBound(T1, 1)
    Dico1(T1(i, 2) & "|" & T1(i, 1)) = Dico1(T1(i, 2) & "|" & T1(i, 1)) + 1
Next

For i = LBound(T2, 1) To UBound(T2, 1)
    If Dico1.exists(T2(i, 1) & "|" & T2(i, 2)) Then
        T3(i, 1) = T2(i, 2)
        T3(i, 2) = T2(i, 1)
    End If
Next

.Range("F2").Resize(UBound(T3, 1), 2) = T3
End With
Set Dico1 = Nothing

End Sub

A+

Merci beaucoup ! En effet, je souhaitais ne pas avoir de doublon mais ait eu du mal à trouver une solution de les enlever sur le couple Code client/Division ou Code client/Point expédition/réception.

La concordance point expédition/réception et Division n'était pas absolument nécessaire mais ça reste un plus. Je vais tester ta solution et surtout essayer de la comprendre histoire de progresser un peu

Encore merci !

C'est peut être un peu trop demandé mais ton code (qui marche super bien) m'a révélé que la liste de gauche possède elle aussi des entrées qui ne sont pas présentes dans celles de droite !

Actuellement, ton code supprime ces entrées et ne met en évidence que les entrées présentes dans la liste de droite qui ne sont pas dans celle de gauche. Comment puis-je l'adapter pour qu'il fasse l'exercice dans les deux sens ?

Merci beaucoup.

Thomas

nouvelle mouture , qui supprime les doublons D-E (que ne faisait pas la version précédente) et qui rajoute les éléments A-B n'existant pas en D-E.

le résultat est copié à partir de la colonne F sur 4 colonnes:

Sub Aligne()
Dim T1, T2, T3, Dico1, Dico2, TT, i As Long
Dim x As Long
Set Dico1 = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")
With Worksheets("Feuil1")
T1 = .Range("A2:B" & .Range("A" & Rows.Count).End(xlUp).Row)
T2 = .Range("D2:E" & .Range("D" & Rows.Count).End(xlUp).Row)

ReDim T3(1 To UBound(T2, 1) + UBound(T1, 1), 1 To 4)
For i = LBound(T1, 1) To UBound(T1, 1)
    Dico1(T1(i, 2) & "|" & T1(i, 1)) = Dico1(T1(i, 2) & "|" & T1(i, 1)) + 1
Next
For i = LBound(T2, 1) To UBound(T2, 1)
    Dico2(T2(i, 1) & "|" & T2(i, 2)) = ""
Next

For Each clé In Dico2.keys 'remplissage de T3 à partir de dico2 (donc sans doublon de T2) et Dico1
    x = x + 1
    If Dico1.exists(clé) Then
        T3(x, 1) = Split(clé, "|")(1)
        T3(x, 2) = Split(clé, "|")(0)
        Dico1.Remove (clé)
    End If
    T3(x, 3) = Split(clé, "|")(0)
    T3(x, 4) = Split(clé, "|")(1)
Next

If Dico1.Count > 0 Then 'rajout dans T3 des données de dico1 n'existant pas dans dico2
    For Each clé In Dico1.keys
        x = x + 1
        T3(x, 1) = Split(clé, "|")(1)
        T3(x, 2) = Split(clé, "|")(0)
    Next
End If
.Range("F2").Resize(x, 4) = T3
End With
Set Dico1 = Nothing

End Sub

Merci ! Je ne comprends pas grand chose au code mais il marche à merveille

quelques explications:

on met les plages de données à utiliser dans des tableaux pour plus de rapidité (T1=colonnes A-B et T2=colonnes D-E)

On balaye chaque tableau pour créer les dictionary Dico1 et Dico2 ayant pour clé la concaténation de la Division et du Point expédition correspondant, séparés par "|". Le dictionaty a la particularité de ne conserver qu'une clé en cas de clés identiques. Donc on élimine les doublons.

Pour chaque clé du Dico2

on écrit les deux composants de la clé dans les colonnes 3 et 4 du Tableau T3

et on vérifie l'existence de cette clé dans le Dico1:

si existe on copie les deux composants de Dico1 dans les colonnes 1 et 2 du Tableau 3 sur la même ligne que ci dessus

on supprime la clé du Dico1

A l'issue il ne reste dans Dico1 que les clés n'ayant pas de correspondance dans Dico2.

Alors, pour chaque clé de Dico1 on copie les deux composants de Dico1 dans les colonnes 1 et 2 du Tableau 3

On copie ce tableau T3 à partir de F2 dans la feuille.

A+ si besoin d'info supplémentaires...

Rechercher des sujets similaires à "mise forme vba saut ligne tant que"