Code à simplifier

Version imprimable

Code à simplifier

Salut,
Je travail sur Excel 2003 , pour remplir ma "Liste 1 " appartir de la "Base A" ,en inscrivant l'Année Scolaire dans la cellule de saisie"H5" ,j'ai fais le code suivant qui fonction bien . Mais peut- on simplifier l'écriture de code?

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
36
37
38
39
40
41
42
43
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, y As Integer
 
If (Target.Address = "$H$5") And Not IsEmpty(Target.Value) Then
    With Application.ThisWorkbook
        .Sheets("Liste1").Range("A9:I65000").ClearContents
 
        x = 3
        y = 8
 
        While (Sheets("Base A").Range("H" & x) <> "")
            If Sheets("Base A").Range("H" & x).Value = Sheets("Liste1").Range("H5").Value Then
                Sheets("Liste1").Range("A" & y).Value = Sheets("Base A").Range("A" & x).Value
                Sheets("Liste1").Range("B" & y).Value = Sheets("Base A").Range("B" & x).Value
                Sheets("Liste1").Range("C" & y).Value = Sheets("Base A").Range("C" & x).Value
                Sheets("Liste1").Range("D" & y).Value = Sheets("Base A").Range("D" & x).Value
                Sheets("Liste1").Range("E" & y).Value = Sheets("Base A").Range("E" & x).Value
                Sheets("Liste1").Range("F" & y).Value = Sheets("Base A").Range("F" & x).Value
                Sheets("Liste1").Range("G" & y).Value = Sheets("Base A").Range("G" & x).Value
                Sheets("Liste1").Range("H" & y).Value = Sheets("Base A").Range("I" & x).Value
                Sheets("Liste1").Range("I" & y).Value = Sheets("Base A").Range("J" & x).Value
                y = y + 1
            End If
 
            x = x + 1
        Wend
 
    End With
 
z = 8
While (Sheets("Liste1").Range("A" & z) <> "")
    z = z + 1
Wend
 
Sheets("Liste1").Select
Range("A8:I" & z).Select
 
Selection.Sort Key1:=Range("A8"), Order1:=xlAscending, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 
End If
 
End Sub

Merci.
Cordialement

SAlut

2 choses me sautent a l'oeil.

Pourquoi avoir gardé les 2 select en fin de code, il faut les intégré sur 1 seule ligne comme pour le reste de ton code
Code:

1 2 Sheets("Liste1").Range("A8:I" & z).Sort Key1:=Range("A8"), Order1:=xlAscending, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
La 2eme c'est cette partie
Code:

1 2 3 4 5 6 7 8 9 Sheets("Liste1").Range("A" & y).Value = Sheets("Base A").Range("A" & x).Value Sheets("Liste1").Range("B" & y).Value = Sheets("Base A").Range("B" & x).Value Sheets("Liste1").Range("C" & y).Value = Sheets("Base A").Range("C" & x).Value Sheets("Liste1").Range("D" & y).Value = Sheets("Base A").Range("D" & x).Value Sheets("Liste1").Range("E" & y).Value = Sheets("Base A").Range("E" & x).Value Sheets("Liste1").Range("F" & y).Value = Sheets("Base A").Range("F" & x).Value Sheets("Liste1").Range("G" & y).Value = Sheets("Base A").Range("G" & x).Value Sheets("Liste1").Range("H" & y).Value = Sheets("Base A").Range("I" & x).Value Sheets("Liste1").Range("I" & y).Value = Sheets("Base A").Range("J" & x).Value
Pourquoi ne pas faire la copie de toute les cellule d'un coup
(L'utilisation de With ici alégeré ton code)
Code:

1 2 3 With Sheets("Liste1") .range(.cells(y,"A"),.cells(y,"I")).value = Sheets("Base A").range(Sheets("Base A").cells(x,"A"),Sheets("Base A").cells(x,"I")).value End With
[Edit]Correction du code[/Edit]Tu peux utiliser Copy aussi si ca te dis

[Edit]
Ho une 3eme
le

Code:

With Application.ThisWorkbook

est inutile, puisque tu es dans le code événementiel du thisworkbook, donc c pas la peine de le re-précisé.

Et de 4
Code:

1 2 3 4 z = 8 While (Sheets("Liste1").Range("A" & z) <> "") z = z + 1 Wend
si c'est pour trouver la derniere ligne non vide c'est comme ca

Code:

z = Sheets("Liste1").cells(rows.count,"A").End(Xlup).Row

[/Edit]
A++
Qwaz

05/04/2009, 11h00
Mapokko

Merci , c'est très gentil de ta part si tu m'écris le code final.
Cordialement
05/04/2009, 11h46
Qwazerty

Salut
Heuu, je veux pas faire le vieux rabat joie, mais on est dans un forum d'entraide certes, mais bon la je t'ai quand même grandement mâché le travail, un peu d'investissement, essais par toi même de modifier ton code en fonction de mes remarques, si tu as put pondre un tel code, ce ne devrait pas etre un soucis, reposte le une fois fait et s'il faut y apporter des corrections je te dirais ca ;)
A++
Qwaz

Jai suivi tes conseils ,mais seulement avec cette partie du code que j'ai le problème.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
If Sheets("Base A").Range("H" & x).Value = Sheets("Liste1").Range("H5").Value Then
                Sheets("Liste1").Range("A" & y).Value = Sheets("Base A").Range("A" & x).Value
                Sheets("Liste1").Range("B" & y).Value = Sheets("Base A").Range("B" & x).Value
                Sheets("Liste1").Range("C" & y).Value = Sheets("Base A").Range("C" & x).Value
                Sheets("Liste1").Range("D" & y).Value = Sheets("Base A").Range("D" & x).Value
                Sheets("Liste1").Range("E" & y).Value = Sheets("Base A").Range("E" & x).Value
                Sheets("Liste1").Range("F" & y).Value = Sheets("Base A").Range("F" & x).Value
                Sheets("Liste1").Range("G" & y).Value = Sheets("Base A").Range("G" & x).Value
                Sheets("Liste1").Range("H" & y).Value = Sheets("Base A").Range("I" & x).Value
                Sheets("Liste1").Range("I" & y).Value = Sheets("Base A").Range("J" & x).Value
                y = y + 1
            End If

pour le reste ça va pas de problème.

Merci
Cordialement

Bonjour qwaz, Mappoko, le forum

Qwaz, excuses-moi je ne veux pas interférer
Mappoko => Qwaz t'a maché le travail,

ton code :

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, y As Integer
 
If (Target.Address = "$H$5") And Not IsEmpty(Target.Value) Then
    With Application.ThisWorkbook
        .Sheets("Liste1").Range("A9:I65000").ClearContents
 
        x = 3
        y = 8
 
        While (Sheets("Base A").Range("H" & x) <> "")
            If Sheets("Base A").Range("H" & x).Value = Sheets("Liste1").Range("H5").Value Then
        With Sheets("Liste1")
            .Range(.Cells(y, "A"), .Cells(y, "I")) = Sheets("Base A").Range(Cells(x, "A"), Cells(x, "I"))
        End With
                y = y + 1
            End If         
            x = x + 1
        Wend  
    End With
Z = 8
While (Sheets("Liste1").Range("A" & Z) <> "")
    Z = Z + 1
Wend
Sheets("Liste1").Range("A8:I" & Z).Sort Key1:=Range("A8"), Order1:=xlAscending, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
End Sub

Merci,C'est ce que j'ai fais moi aussi,mais c'est toujours le même problème mes amis .

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
If (Target.Address = "$H$5") And Not IsEmpty(Target.Value) Then
    With Application.ThisWorkbook
        .Sheets("Liste1").Range("A9:I65000").ClearContents
    
        x = 3
        y = 8
        
        While (Sheets("Base A").Range("H" & x) <> "")
            If Sheets("Base A").Range("H" & x).Value = Sheets("Liste1").Range("H5").Value Then
        With Sheets("Liste1")
            .Range(.Cells(y, "A"), .Cells(y, "I")) = Sheets("Base A").Range(Cells(x, "A"), Cells(x, "I"))        End With
                y = y + 1
            End If
            x = x + 1
        Wend
    End With
z = 8
While (Sheets("Liste1").Range("A" & z) <> "")
    z = z + 1
Wend
Sheets("Liste1").Range("A8:I" & z).Sort Key1:=Range("A8"), Order1:=xlAscending, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
End Sub

car dans mon cas il y a une case que j'ai pas mentionné regarder bien mon code

Code:

1
2
3
4
5
6
7
8
9
10
11
If Sheets("Base A").Range("H" & x).Value = Sheets("Liste1").Range("H5").Value Then
           Sheets("Liste1").Range("A" & y).Value = Sheets("Base A").Range("A" & x).Value
                Sheets("Liste1").Range("B" & y).Value = Sheets("Base A").Range("B" & x).Value
                Sheets("Liste1").Range("C" & y).Value = Sheets("Base A").Range("C" & x).Value
                Sheets("Liste1").Range("D" & y).Value = Sheets("Base A").Range("D" & x).Value
                Sheets("Liste1").Range("E" & y).Value = Sheets("Base A").Range("E" & x).Value
                Sheets("Liste1").Range("F" & y).Value = Sheets("Base A").Range("F" & x).Value
                Sheets("Liste1").Range("G" & y).Value = Sheets("Base A").Range("G" & x).Value
                Sheets("Liste1").Range("H" & y).Value = Sheets("Base A").Range("I" & x).Value                Sheets("Liste1").Range("I" & y).Value = Sheets("Base A").Range("J" & x).Value
                y = y + 1
            End If

Ok, alors je pense à ce code :

Code:

1
2
3
4
5
  With Sheets("Liste1")
            .Range(.Cells(y, "A"), .Cells(y, "g")) = Sheets("Base A").Range(Cells(x, "A"), Cells(x, "g"))
            .Cells(y, "H").Value = Sheets("Base A").Cells(x, "I").Value
            .Cells(y, "I").Value = Sheets("Base A").Cells(x, "J").Value
        End With

05/04/2009, 13h42
Mapokko

toujours l'erreur dans cette ligne

Code:

.Range(.Cells(y, "A"), .Cells(y, "g")) = Sheets("Base A").Range(.Cells(x, "A"), .Cells(x, "g"))
05/04/2009, 13h46
casefayere

Ton erruer est normale, regardes bien ton code

Code:

.Range(.Cells(y, "A"), .Cells(y, "g")) = Sheets("Base A").Range(.Cells(x, "A"), .Cells(x, "g"))

et celui qu'il faut

Code:

.Range(.Cells(y, "A"), .Cells(y, "g")) = Sheets("Base A").Range(Cells(x, "A"), Cells(x, "g"))

il y a une différence
05/04/2009, 13h47
Qwazerty

Re
Pour l'erreur sur la ligne, c'est normal relis mon code et compare le au tient, tu vas voir que la partie droite de l'égalité de ta ligne et fausse
[Edit]Tu as repondu entre temps Casefayere, mais ce n'est pas encore tout a fait ca non plus.
Si tu met juste cells seul excel va chercher dans la feuille courante, hors ici on veux aller chercher dans BaseA.
[/Edit]

Il y a d'autres point que j'ai sité dans mon 1er message, tu les as peut être manqué car j'avais édite le message plusieurs fois.
A++
Qwaz
05/04/2009, 13h53
casefayere

re qwaz,

je pensais que le fait de préciser la feuille avant range suffisait, mais, voilà une expérience de plus

a +

Lorsque j'utilise ta solution Mr.Qwazerty ,il n y a aucun remplissage dans ma liste . rien ne se passe
Code:

1 2 3 With Sheets("Liste1") .range(.cells(y,"A"),.cells(y,"I")) = Sheets("Base A").range(Sheets("Base A").cells(x,"A"),Sheets("Base A").cells(x,"I")) End With

05/04/2009, 14h07
Qwazerty

Rajoutes .Value a la fin des 2 corps et laisses les Mr de coté stp.
Je corrige mon 1er message
++
Qwaz

Il fallait prendre la propo de qwaz mais corriger en fonction de e que je t'ai mis

Code:

1
2
3
4
5
6
With Sheets("Liste1")
  .range(.cells(y,"A"),.cells(y,"g")) = Sheets("Base A").range(Sheets("Base A").cells(x,"A"),Sheets("Base A").cells(x,"g"))
 .Cells(y, "H").Value = Sheets("Base A").Cells(x, "I").Value
            .Cells(y, "I").Value = Sheets("Base A").Cells(x, "J").Value
 
End With

05/04/2009, 14h13
Qwazerty

Re
@ CaseFayere:
Non en effet ce n'est pas suffisant, j'avais cris dans la réponse d'un post a ce sujet mais je sais plus lequel. En fait c plutôt logique si on regarde bien
Le fait de ne rien mettre devant cells indique a excel que la feuille utilisé et la feuille courante.
donc écrire

Code:

sheets("Feuil1").range(cells(1,"A"),cells(1,"G"))

revient pour excel si on est sur la feuil2 a dire

Code:

sheets("Feuil1").range(sheets("Feuil2").cells(1,"A"),sheets("Feuil2").cells(1,"G"))

ce qui tu l'admettras est plutôt difficile a interpréter.
[Edit]
On se croise a chaque fois ^^
Il faut mettre .value a la fin de 2 corps de l'égalité, sinon excel ne prend pas en compte, c'est d'ailleurs une mauvaise habitude que la notre de toujours laisser a excel le soin de rajouter le membre par défaut a la suite des ranges.
[/Edit]
a++
Qwaz

Merci , c'est résolu :yaisse2:
le code final:

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, y As Integer
 
If (Target.Address = "$H$5") And Not IsEmpty(Target.Value) Then
    With Application.ThisWorkbook
        .Sheets("Liste1").Range("A9:I65000").ClearContents
 
        x = 3
        y = 8
 
        While (Sheets("Base A").Range("H" & x) <> "")
            If Sheets("Base A").Range("H" & x).Value = Sheets("Liste1").Range("H5").Value Then
 
 
  With Sheets("Liste1")
  .Range(.Cells(y, "A"), .Cells(y, "g")).Value = Sheets("Base A").Range(Sheets("Base A").Cells(x, "A"), Sheets("Base A").Cells(x, "g")).Value
  .Range(.Cells(y, "H"), .Cells(y, "I")).Value = Sheets("Base A").Range(Sheets("Base A").Cells(x, "I"), Sheets("Base A").Cells(x, "J")).Value
 End With
 
                y = y + 1
            End If
            x = x + 1
        Wend
    End With
z = 8
While (Sheets("Liste1").Range("A" & z) <> "")
    z = z + 1
Wend
Sheets("Liste1").Range("A8:I" & z).Sort Key1:=Range("A8"), Order1:=xlAscending, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
End Sub

Cordialement