Insertion selon condition

Version imprimable

13/11/2013, 12h59
Galdwin

1 pièce(s) jointe(s)

Insertion selon condition

Bonjour,

Voilà apres plusieur jour de recherche je trouve pas ce que je recherche.
Alors je vais vous expliquer.
J'ai une feuille "ECART"

Dans cette feuille j'ai deux tableau mis cote à cote.
On appelera le Tableau 1 les collones A à D et Tableau 2 de E a H.
J'ai dans la collone A du tableau 1 des numero de client.
Ces même numero de retrouve dans le Tableau 2 en collone E.
Je fait un tri croissant sur les deux tableaux en collone A et E.

Le problème c'est que lorsque je fait un tris, j'ai pas toujours le même numero de client sur le même ligne.

Par exemple:

En A4 j'ai le client 12345 en E4 j'ai le client 12346.
Vue que j'ai pas le même client, j'aimerais insérer une ligne de E4 a H4 si et seulement si les valeur de EX ne sont pas identique en AX.Après la macro passe à la seconde ligne jusque la dernier.

J'aimerais que la macro face tout les ligne jusque la dernier blanche des collone E à H. Car les donner peuvent varier

J'espers avoir était claire. Au pire je vais vous mettre un fichier pour montrer ce que sa donne avant et apres la macro.

Cordialement

Fichier joint:

Je copie ton tableau de départ en A1 de la feuille 2. Puis: A adapter

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub toto()
    Dim i As Long, j As Long, k As Long
    k = 2
    With Sheets("Feuil2")
        For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
            Feuil3.Cells(k, 1) = .Cells(i, 1)
            Feuil3.Cells(k, 2) = .Cells(i, 2)
            Feuil3.Cells(k, 3) = .Cells(i, 3)
            Feuil3.Cells(k, 4) = .Cells(i, 4)
            For j = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
                If .Cells(i, 1) = .Cells(j, 5) Then
                    Feuil3.Cells(k, 5) = .Cells(i, 5)
                    Feuil3.Cells(k, 6) = .Cells(i, 6)
                    Feuil3.Cells(k, 7) = .Cells(i, 7)
                    bool = True
                End If
            Next j
            k = k + 1
        Next i
    End With
End Sub

13/11/2013, 14h28
Galdwin

1 pièce(s) jointe(s)

J'ai testé la macro sans la modifier. J'ai pris le tableau et coller en A1 de la feuille 2 sauf que le résultat en feuille 3 est pas correct.
Je tes uplodé le meme fichier apres macro sur la feuille 3 ainsi que le résultat que normalement je devrais avoir.

Cordialement

Petite coquille

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub toto()
    Dim i As Long, j As Long, k As Long
    k = 2
    With Sheets("Feuil2")
        For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
            Feuil3.Cells(k, 1) = .Cells(i, 1)
            Feuil3.Cells(k, 2) = .Cells(i, 2)
            Feuil3.Cells(k, 3) = .Cells(i, 3)
            Feuil3.Cells(k, 4) = .Cells(i, 4)
            For j = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
                If .Cells(i, 1) = .Cells(j, 5) Then
                    Feuil3.Cells(k, 5) = .Cells(j, 5)
                    Feuil3.Cells(k, 6) = .Cells(j, 6)
                    Feuil3.Cells(k, 7) = .Cells(j, 7)
                    bool = True
                End If
            Next j
            k = k + 1
        Next i
    End With
End Sub

13/11/2013, 14h41
Galdwin

?? Je comprend pas "Petite coquille" :oops:
13/11/2013, 14h43
EngueEngue

dans ma deuxième boucle j'avais mis des i et pas de j :P
13/11/2013, 14h46
Galdwin

Ha oki, je viens de teste sa marche nickel par contre j'ai testé avec un numéro qui n'est pas forcement référencé dans la collone de A a D mais se numero a disparue.

Tu pourrais faire en sorte que les numeros de client inscrit en collone E qui ne sont pas référencer en A soit mis en dernier ligne de E a H pour pas perdre des données ? et inversement avec la collone A des numeros peuve ne pas être référencer en E.

Merci beaucoup

Décidemment je suis une quiche aujourd'hui.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub toto()
    Dim i As Long, j As Long, k As Long, bool as boolean
    k = 2
    With Sheets("Feuil2")
        For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
            Feuil3.Cells(k, 1) = .Cells(i, 1)
            Feuil3.Cells(k, 2) = .Cells(i, 2)
            Feuil3.Cells(k, 3) = .Cells(i, 3)
            Feuil3.Cells(k, 4) = .Cells(i, 4)
            For j = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
                If .Cells(i, 1) = .Cells(j, 5) Then
                    Feuil3.Cells(k, 5) = .Cells(j, 5)
                    Feuil3.Cells(k, 6) = .Cells(j, 6)
                    Feuil3.Cells(k, 7) = .Cells(j, 7)
 
                End If
            Next j
            k = k + 1
        Next i
        For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
            Bool = False
                For j = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
                    If .Cells(i, 5) = .Cells(j, 1) Then
                        Bool = True
                    End If
                Next j
            If Not (Bool) Then
                Feuil3.Cells(k, 5) = .Cells(i, 5)
                Feuil3.Cells(k, 6) = .Cells(i, 6)
                Feuil3.Cells(k, 7) = .Cells(i, 7)
                k = k + 1
            End If
        Next i
    End With
End Sub

13/11/2013, 15h16
Galdwin

Non c'est moi j'aurais du te préciser de pas perdre les données.
Sa fonctionne super bien.
Je t'en remercie.

Bonne journée.
Sujet Résolut !!
26/11/2013, 14h05
Galdwin

Merci encor pour cette macro. Un problème est arrivé lorsque j'ai eu le retour d'un collégue.

La macro me supprime des lignes lorsque les données des collones E à H sont plus long que les données mis en A à D.

En effet, il ce peux qu'il me manque des données.

Comment réssoudre le problème pour pas qu'il me supprimer des lignes.

Cordialement

Edit: je pense savoir d'ou vien le probème.
Cela viendrais des lignes => Range("A" & .Rows.Count).End(xlUp).Row.

En effet les lignes supprimer sont les derniers donc la macro s'arrete a la dernier ligne de A non vide et le problème c'est qu'il ce peux que j'en est d'autre.

Se serait possible de faire => Range("A" & .Rows.Count).End(xlUp).Row+10 ?

Comme sa la macro prendre jusque 10 ligne en plus en cas de surplus de donnée dans le tableau de E a H