Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Procedure trop longue suite

Procedure trop longue suite

17 réponses
Avatar
IMER09
Bonjour a tous
J'ai donc essaye de cinder ma procedure en 2
La procedure est sur un bouton VALIDER ds un UF1, la procedure cree une
feuille puis aplique des valeurs à certaine cellule en fonction des combobox
renseignées ds UF1, puis tjs en fonction des combobox renseignee ds UF1 me
fait un tri d'une feuil pour copier ce tri sur la nouvelle feuil creer,puis
encore en fonction des combobox renseigne ds UF1 me fait etc...

J'ai donc cindé la premiere parti en la copiant ds un modul Sub SUITE()et
Call SUITE j'ai un Bug Objet Requis
Qd j'affecte cette macro a un deuxieme bouton ds UF1 (Par ex VALIDER 2) tout
fonctionne parfaitement, mais 2 bouton c'est pas terrible!!!
J'ai fait plusieur essai sans resultat c'est pourquoi je me tourne vers vous
une nouvelle fois
Merci d'avance
--
IMER09
Signaler un problème avec ce contenu

7 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
IMER09
Bonsoir MichDenis
Je viens d'essayer les <> codes que tu m'avait fournit le premier fonctionne
tres bien j'ai meme reussi à alonger mon code ss Bug: ce n'etait donc pas les
If !!! Par contre le second ne fonctionne pas je bug tout d'abord sur
"Me." des CBB une fois les "Me" enlever je Bug sur Sheets(ShDepart) de la
sous procedure.
Quand à la troisieme partie : La premiere adapter ne bug pas mais aucun trie
ne se fait je ne vois pas pourquoi et je n'est pas essayé la deuxieme adapté

Merci pour ton aide ds l'attente à bientot
--
IMER09



| va régler mon pb de procedure trop longue,

Voici un bout de texte qui commente le poids que peut avoir
le code d'un module... malheureusement, je n'ai plu l'auteur
de ces lignes ...probablement, cette limite ne s'adresse pas
à la version Excel 2007

********************
"VBA has an undocumented "soft limit" on the maximum size of any single
standard code module. A standard code moldule should not exceed 64 KB as
measured by its text file size when exported from the project.Your
project will not crash immediately upon a single module exceeding this
64KB limit, but consistently exceeding this limit will almost invariably
lead to an unstable application."
********************

Et 64 Kb, c'est déjà beaucoup !

Je n'ai jamais rien vu ou lu quelque chose qui limiterait le nombre de
if ... Then dans une procédure ou une limitation quant au nombre
limite de lignes de code qu'une procédure peut contenir. (ceci ne
signifie pas que cela n'existe pas...)

Les messages précédents représentent simplement une autre façon d'écrire
le code mais d'une manière plus concise. (En supposant qu'elles fonctionnent
car elles n'ont pas été testées)... Est-ce que le code représente bien ce que
tu tentes de faire ? Ça c'est une autre question que je ne saurais répondre.




"IMER09" a écrit dans le message de news:

Merci MichDenis pour tout ce travail
Je n'est pas pu tester il se fait tard
Est ce que tu croix que le fait de racourcir:

.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4) etc

par

'Copie de la plage de cellule
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)).value= _
Range(Cells(C.Row, 1), Cells(C.Row, 39)).value
Ligne = Ligne + 1

va regler mon pb de procedure trop longue, j'avais l'impression que c'etait
plutot le nbr de If a la suite qui me rendait cette procedure trop longue.
Par contre ta seconde proposition m'enleve en effet un If a chaque fois soit
11 If, la piste me semble bonne.
Mais ne serait il pas possible de prendre en compte que les ComboBox
renseignés avant de faire le trie auquel cas je n'aurai plus qu'1 seule
partie et non plus 11, cela me laisssrai par la meme occasion la possibilté
d'ajoute des cas

J'espere mettre bien expliqué, merci encore
Je ne manquerai pas de te tenir au courant du resultat dès que j'aurai un
peu de temps pour tout remanier
--
IMER09



On peut même remplacer la boucle
For a = 39 dans la procédure proposée par
la première procédure par simplement
un copie d'une plage de cellules proposée
dans la deuxième procédure
'-------------------------
Sub Execution(Ligne As Long, Rg As Range)

With Sheets(ShDepart)
For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
For A = 1 To 39
.Cells(Ligne, A) = Cells(C.Row, A)
Next
Ligne = Ligne + 1
End If
Next
End With
End Sub
'-----------------------

par

'-------------------------
Sub Execution(Ligne As Long, Rg As Range)

With Sheets(ShDepart)
For Each C In Rg
Range(Cells(C.Row, 1), Cells(C.Row, 39)).Address
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
'Copie de la plage de cellule
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)).value= _
Range(Cells(C.Row, 1), Cells(C.Row, 39)).value
Ligne = Ligne + 1
End If
Next
End With
End Sub
'------------------------------

Dans la toute première procédure proposée, tu obtiendrais quelque chose dans le gennre :


Sub test()

Dim Ligne As Long, C As Range
Dim Rg As Range, A As Integer

Sheets("Archive").Select
With Sheets(ShDepart)
'CA TOTAL/1/1
If ComboBox1.Value <> "" And ComboBox2.Value = "" _
And ComboBox3.Value = "" And ComboBox4.Value = "" _
And ComboBox5.Value = "" And ComboBox6.Value = "" And _
.ComboBox7.Value <> "FAUX" And ComboBox8.Value = "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
Set Rg = Range("AJ4", Range("AJ65536").End(xlUp))

For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, -33) = Me.ComboBox1 Then
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)) = _
Range(Cells(C.Row, 1), Cells(C.Row, 39))
Ligne = Ligne + 1
End If
Next

'CA TOTAL/1/2
If ComboBox1.Value = "" And ComboBox2.Value <> "" _
And ComboBox3.Value = "" And ComboBox4.Value = "" _
And ComboBox5.Value = "" And ComboBox6.Value = "" _
And ComboBox7.Value <> "FAUX" And ComboBox8.Value = "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
Set Rg = Range("AJ4", Range("AJ65536").End(xlUp))

For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)) = _
Range(Cells(C.Row, 1), Cells(C.Row, 39))
Ligne = Ligne + 1
End If
Next
End If

End Sub
'----------------------






"IMER09" a écrit dans le message de news:

J'ai 8 Cobox ds un UF, chaque box recupere les criteres de 8 colonnes d'une
feuil archive qui comporte 39 colonnes
Avec un bouton valider je cree une feuil dont le non et une compilation des
CB renseigner je trie ensuite la feuille archive en fonction des criteres de
chaque CB que je colle ds ma new feuil cree(code ci dessous)
Pour finir je fait un certain nbre de calcul ds cette feuil cree
J'ai donc une macro tres longue que je voudrai encore agrandir
Le pb, je croix, est que mes CB n'ont pas forcement toute une valeur,
certaine reste blanche. J'ai donc du mettre ds mon code un nbr de If
important
Rien que pour le trie par ex j'ai 11 If qui corresponde a 11 critere de
trie possible

voici une partie de mon Code:

Sheets("Archive").Select
Dim Ligne As Long, C As Range
With Sheets(ShDepart)


'CA TOTAL/1/1
If ComboBox1.Value <> "" And ComboBox2.Value = "" And ComboBox3.Value = "" _
And ComboBox4.Value = "" And ComboBox5.Value = "" _
And ComboBox6.Value = "" And ComboBox7.Value <> "FAUX" And ComboBox8.Value > > "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
For Each C In Range("AJ4", Range("AJ65536").End(xlUp))
If C = Me.ComboBox7 And C.Offset(, -33) = Me.ComboBox1 Then
.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4)
.Cells(Ligne, 5) = Cells(C.Row, 5)
.Cells(Ligne, 6) = Cells(C.Row, 6)
.Cells(Ligne, 7) = Cells(C.Row, 7)
.Cells(Ligne, 8) = Cells(C.Row, 8)
.Cells(Ligne, 9) = Cells(C.Row, 9)
.Cells(Ligne, 10) = Cells(C.Row, 10)
.Cells(Ligne, 11) = Cells(C.Row, 11)
.Cells(Ligne, 12) = Cells(C.Row, 12)
.Cells(Ligne, 13) = Cells(C.Row, 13)
.Cells(Ligne, 14) = Cells(C.Row, 14)
.Cells(Ligne, 15) = Cells(C.Row, 15)
.Cells(Ligne, 16) = Cells(C.Row, 16)
.Cells(Ligne, 17) = Cells(C.Row, 17)
.Cells(Ligne, 18) = Cells(C.Row, 18)
.Cells(Ligne, 19) = Cells(C.Row, 19)
.Cells(Ligne, 20) = Cells(C.Row, 20)
.Cells(Ligne, 21) = Cells(C.Row, 21)
.Cells(Ligne, 22) = Cells(C.Row, 22)
.Cells(Ligne, 23) = Cells(C.Row, 23)
.Cells(Ligne, 24) = Cells(C.Row, 24)
.Cells(Ligne, 25) = Cells(C.Row, 25)
.Cells(Ligne, 26) = Cells(C.Row, 26)
.Cells(Ligne, 27) = Cells(C.Row, 27)
.Cells(Ligne, 28) = Cells(C.Row, 28)
.Cells(Ligne, 29) = Cells(C.Row, 29)
.Cells(Ligne, 30) = Cells(C.Row, 30)
.Cells(Ligne, 31) = Cells(C.Row, 31)
.Cells(Ligne, 32) = Cells(C.Row, 32)
.Cells(Ligne, 33) = Cells(C.Row, 33)
.Cells(Ligne, 34) = Cells(C.Row, 34)
.Cells(Ligne, 35) = Cells(C.Row, 35)
.Cells(Ligne, 36) = Cells(C.Row, 36)
.Cells(Ligne, 37) = Cells(C.Row, 37)
.Cells(Ligne, 38) = Cells(C.Row, 38)
.Cells(Ligne, 39) = Cells(C.Row, 39)
Ligne = Ligne + 1
End If
Next C
End If


'CA TOTAL/1/2
If ComboBox1.Value = "" And ComboBox2.Value <> "" And ComboBox3.Value = "" _
And ComboBox4.Value = "" And ComboBox5.Value = "" _
And ComboBox6.Value = "" And ComboBox7.Value <> "FAUX" And ComboBox8.Value > > "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
For Each C In Range("AJ4", Range("AJ65536").End(xlUp))
If C = Me.ComboBox7 _
And C.Offset(, 3) = Me.ComboBox2 Then
.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4)
.Cells(Ligne, 5) = Cells(C.Row, 5)
.Cells(Ligne, 6) = Cells(C.Row, 6)
.Cells(Ligne, 7) = Cells(C.Row, 7)
.Cells(Ligne, 8) = Cells(C.Row, 8)
.Cells(Ligne, 9) = Cells(C.Row, 9)
.Cells(Ligne, 10) = Cells(C.Row, 10)
.Cells(Ligne, 11) = Cells(C.Row, 11)
.Cells(Ligne, 12) = Cells(C.Row, 12)
.Cells(Ligne, 13) = Cells(C.Row, 13)
.Cells(Ligne, 14) = Cells(C.Row, 14)
.Cells(Ligne, 15) = Cells(C.Row, 15)
.Cells(Ligne, 16) = Cells(C.Row, 16)
.Cells(Ligne, 17) = Cells(C.Row, 17)
.Cells(Ligne, 18) = Cells(C.Row, 18)
.Cells(Ligne, 19) = Cells(C.Row, 19)
.Cells(Ligne, 20) = Cells(C.Row, 20)
.Cells(Ligne, 21) = Cells(C.Row, 21)
.Cells(Ligne, 22) = Cells(C.Row, 22)
.Cells(Ligne, 23) = Cells(C.Row, 23)
.Cells(Ligne, 24) = Cells(C.Row, 24)
.Cells(Ligne, 25) = Cells(C.Row, 25)
.Cells(Ligne, 26) = Cells(C.Row, 26)
.Cells(Ligne, 27) = Cells(C.Row, 27)
.Cells(Ligne, 28) = Cells(C.Row, 28)
.Cells(Ligne, 29) = Cells(C.Row, 29)
.Cells(Ligne, 30) = Cells(C.Row, 30)
.Cells(Ligne, 31) = Cells(C.Row, 31)
.Cells(Ligne, 32) = Cells(C.Row, 32)
.Cells(Ligne, 33) = Cells(C.Row, 33)
.Cells(Ligne, 34) = Cells(C.Row, 34)
.Cells(Ligne, 35) = Cells(C.Row, 35)
.Cells(Ligne, 36) = Cells(C.Row, 36)
.Cells(Ligne, 37) = Cells(C.Row, 37)
.Cells(Ligne, 38) = Cells(C.Row, 38)
.Cells(Ligne, 39) = Cells(C.Row, 39)
Ligne = Ligne + 1
End If
Next C
End If

Etc...

Pour le nom de la feuil c'est la meme chose etc

J'espere avoir ete explicite merci et malgres tout pas trop long !!!

--
IMER09






Avatar
MichDenis
Tu les enlèves tout simplement les Me. (n'oublie pas d'enlever le point aussi)


"IMER09" a écrit dans le message de news:

Bonsoir MichDenis
Je viens d'essayer les <> codes que tu m'avait fournit le premier fonctionne
tres bien j'ai meme reussi à alonger mon code ss Bug: ce n'etait donc pas les
If !!! Par contre le second ne fonctionne pas je bug tout d'abord sur
"Me." des CBB une fois les "Me" enlever je Bug sur Sheets(ShDepart) de la
sous procedure.
Quand à la troisieme partie : La premiere adapter ne bug pas mais aucun trie
ne se fait je ne vois pas pourquoi et je n'est pas essayé la deuxieme adapté

Merci pour ton aide ds l'attente à bientot
--
IMER09



| va régler mon pb de procedure trop longue,

Voici un bout de texte qui commente le poids que peut avoir
le code d'un module... malheureusement, je n'ai plu l'auteur
de ces lignes ...probablement, cette limite ne s'adresse pas
à la version Excel 2007

********************
"VBA has an undocumented "soft limit" on the maximum size of any single
standard code module. A standard code moldule should not exceed 64 KB as
measured by its text file size when exported from the project.Your
project will not crash immediately upon a single module exceeding this
64KB limit, but consistently exceeding this limit will almost invariably
lead to an unstable application."
********************

Et 64 Kb, c'est déjà beaucoup !

Je n'ai jamais rien vu ou lu quelque chose qui limiterait le nombre de
if ... Then dans une procédure ou une limitation quant au nombre
limite de lignes de code qu'une procédure peut contenir. (ceci ne
signifie pas que cela n'existe pas...)

Les messages précédents représentent simplement une autre façon d'écrire
le code mais d'une manière plus concise. (En supposant qu'elles fonctionnent
car elles n'ont pas été testées)... Est-ce que le code représente bien ce que
tu tentes de faire ? Ça c'est une autre question que je ne saurais répondre.




"IMER09" a écrit dans le message de news:

Merci MichDenis pour tout ce travail
Je n'est pas pu tester il se fait tard
Est ce que tu croix que le fait de racourcir:

.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4) etc

par

'Copie de la plage de cellule
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)).value= _
Range(Cells(C.Row, 1), Cells(C.Row, 39)).value
Ligne = Ligne + 1

va regler mon pb de procedure trop longue, j'avais l'impression que c'etait
plutot le nbr de If a la suite qui me rendait cette procedure trop longue.
Par contre ta seconde proposition m'enleve en effet un If a chaque fois soit
11 If, la piste me semble bonne.
Mais ne serait il pas possible de prendre en compte que les ComboBox
renseignés avant de faire le trie auquel cas je n'aurai plus qu'1 seule
partie et non plus 11, cela me laisssrai par la meme occasion la possibilté
d'ajoute des cas

J'espere mettre bien expliqué, merci encore
Je ne manquerai pas de te tenir au courant du resultat dès que j'aurai un
peu de temps pour tout remanier
--
IMER09



On peut même remplacer la boucle
For a = 39 dans la procédure proposée par
la première procédure par simplement
un copie d'une plage de cellules proposée
dans la deuxième procédure
'-------------------------
Sub Execution(Ligne As Long, Rg As Range)

With Sheets(ShDepart)
For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
For A = 1 To 39
.Cells(Ligne, A) = Cells(C.Row, A)
Next
Ligne = Ligne + 1
End If
Next
End With
End Sub
'-----------------------

par

'-------------------------
Sub Execution(Ligne As Long, Rg As Range)

With Sheets(ShDepart)
For Each C In Rg
Range(Cells(C.Row, 1), Cells(C.Row, 39)).Address
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
'Copie de la plage de cellule
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)).value= _
Range(Cells(C.Row, 1), Cells(C.Row, 39)).value
Ligne = Ligne + 1
End If
Next
End With
End Sub
'------------------------------

Dans la toute première procédure proposée, tu obtiendrais quelque chose dans le gennre :


Sub test()

Dim Ligne As Long, C As Range
Dim Rg As Range, A As Integer

Sheets("Archive").Select
With Sheets(ShDepart)
'CA TOTAL/1/1
If ComboBox1.Value <> "" And ComboBox2.Value = "" _
And ComboBox3.Value = "" And ComboBox4.Value = "" _
And ComboBox5.Value = "" And ComboBox6.Value = "" And _
.ComboBox7.Value <> "FAUX" And ComboBox8.Value = "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
Set Rg = Range("AJ4", Range("AJ65536").End(xlUp))

For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, -33) = Me.ComboBox1 Then
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)) = _
Range(Cells(C.Row, 1), Cells(C.Row, 39))
Ligne = Ligne + 1
End If
Next

'CA TOTAL/1/2
If ComboBox1.Value = "" And ComboBox2.Value <> "" _
And ComboBox3.Value = "" And ComboBox4.Value = "" _
And ComboBox5.Value = "" And ComboBox6.Value = "" _
And ComboBox7.Value <> "FAUX" And ComboBox8.Value = "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
Set Rg = Range("AJ4", Range("AJ65536").End(xlUp))

For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)) = _
Range(Cells(C.Row, 1), Cells(C.Row, 39))
Ligne = Ligne + 1
End If
Next
End If

End Sub
'----------------------






"IMER09" a écrit dans le message de news:

J'ai 8 Cobox ds un UF, chaque box recupere les criteres de 8 colonnes d'une
feuil archive qui comporte 39 colonnes
Avec un bouton valider je cree une feuil dont le non et une compilation des
CB renseigner je trie ensuite la feuille archive en fonction des criteres de
chaque CB que je colle ds ma new feuil cree(code ci dessous)
Pour finir je fait un certain nbre de calcul ds cette feuil cree
J'ai donc une macro tres longue que je voudrai encore agrandir
Le pb, je croix, est que mes CB n'ont pas forcement toute une valeur,
certaine reste blanche. J'ai donc du mettre ds mon code un nbr de If
important
Rien que pour le trie par ex j'ai 11 If qui corresponde a 11 critere de
trie possible

voici une partie de mon Code:

Sheets("Archive").Select
Dim Ligne As Long, C As Range
With Sheets(ShDepart)


'CA TOTAL/1/1
If ComboBox1.Value <> "" And ComboBox2.Value = "" And ComboBox3.Value = "" _
And ComboBox4.Value = "" And ComboBox5.Value = "" _
And ComboBox6.Value = "" And ComboBox7.Value <> "FAUX" And ComboBox8.Value > > "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
For Each C In Range("AJ4", Range("AJ65536").End(xlUp))
If C = Me.ComboBox7 And C.Offset(, -33) = Me.ComboBox1 Then
.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4)
.Cells(Ligne, 5) = Cells(C.Row, 5)
.Cells(Ligne, 6) = Cells(C.Row, 6)
.Cells(Ligne, 7) = Cells(C.Row, 7)
.Cells(Ligne, 8) = Cells(C.Row, 8)
.Cells(Ligne, 9) = Cells(C.Row, 9)
.Cells(Ligne, 10) = Cells(C.Row, 10)
.Cells(Ligne, 11) = Cells(C.Row, 11)
.Cells(Ligne, 12) = Cells(C.Row, 12)
.Cells(Ligne, 13) = Cells(C.Row, 13)
.Cells(Ligne, 14) = Cells(C.Row, 14)
.Cells(Ligne, 15) = Cells(C.Row, 15)
.Cells(Ligne, 16) = Cells(C.Row, 16)
.Cells(Ligne, 17) = Cells(C.Row, 17)
.Cells(Ligne, 18) = Cells(C.Row, 18)
.Cells(Ligne, 19) = Cells(C.Row, 19)
.Cells(Ligne, 20) = Cells(C.Row, 20)
.Cells(Ligne, 21) = Cells(C.Row, 21)
.Cells(Ligne, 22) = Cells(C.Row, 22)
.Cells(Ligne, 23) = Cells(C.Row, 23)
.Cells(Ligne, 24) = Cells(C.Row, 24)
.Cells(Ligne, 25) = Cells(C.Row, 25)
.Cells(Ligne, 26) = Cells(C.Row, 26)
.Cells(Ligne, 27) = Cells(C.Row, 27)
.Cells(Ligne, 28) = Cells(C.Row, 28)
.Cells(Ligne, 29) = Cells(C.Row, 29)
.Cells(Ligne, 30) = Cells(C.Row, 30)
.Cells(Ligne, 31) = Cells(C.Row, 31)
.Cells(Ligne, 32) = Cells(C.Row, 32)
.Cells(Ligne, 33) = Cells(C.Row, 33)
.Cells(Ligne, 34) = Cells(C.Row, 34)
.Cells(Ligne, 35) = Cells(C.Row, 35)
.Cells(Ligne, 36) = Cells(C.Row, 36)
.Cells(Ligne, 37) = Cells(C.Row, 37)
.Cells(Ligne, 38) = Cells(C.Row, 38)
.Cells(Ligne, 39) = Cells(C.Row, 39)
Ligne = Ligne + 1
End If
Next C
End If


'CA TOTAL/1/2
If ComboBox1.Value = "" And ComboBox2.Value <> "" And ComboBox3.Value = "" _
And ComboBox4.Value = "" And ComboBox5.Value = "" _
And ComboBox6.Value = "" And ComboBox7.Value <> "FAUX" And ComboBox8.Value > > "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
For Each C In Range("AJ4", Range("AJ65536").End(xlUp))
If C = Me.ComboBox7 _
And C.Offset(, 3) = Me.ComboBox2 Then
.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4)
.Cells(Ligne, 5) = Cells(C.Row, 5)
.Cells(Ligne, 6) = Cells(C.Row, 6)
.Cells(Ligne, 7) = Cells(C.Row, 7)
.Cells(Ligne, 8) = Cells(C.Row, 8)
.Cells(Ligne, 9) = Cells(C.Row, 9)
.Cells(Ligne, 10) = Cells(C.Row, 10)
.Cells(Ligne, 11) = Cells(C.Row, 11)
.Cells(Ligne, 12) = Cells(C.Row, 12)
.Cells(Ligne, 13) = Cells(C.Row, 13)
.Cells(Ligne, 14) = Cells(C.Row, 14)
.Cells(Ligne, 15) = Cells(C.Row, 15)
.Cells(Ligne, 16) = Cells(C.Row, 16)
.Cells(Ligne, 17) = Cells(C.Row, 17)
.Cells(Ligne, 18) = Cells(C.Row, 18)
.Cells(Ligne, 19) = Cells(C.Row, 19)
.Cells(Ligne, 20) = Cells(C.Row, 20)
.Cells(Ligne, 21) = Cells(C.Row, 21)
.Cells(Ligne, 22) = Cells(C.Row, 22)
.Cells(Ligne, 23) = Cells(C.Row, 23)
.Cells(Ligne, 24) = Cells(C.Row, 24)
.Cells(Ligne, 25) = Cells(C.Row, 25)
.Cells(Ligne, 26) = Cells(C.Row, 26)
.Cells(Ligne, 27) = Cells(C.Row, 27)
.Cells(Ligne, 28) = Cells(C.Row, 28)
.Cells(Ligne, 29) = Cells(C.Row, 29)
.Cells(Ligne, 30) = Cells(C.Row, 30)
.Cells(Ligne, 31) = Cells(C.Row, 31)
.Cells(Ligne, 32) = Cells(C.Row, 32)
.Cells(Ligne, 33) = Cells(C.Row, 33)
.Cells(Ligne, 34) = Cells(C.Row, 34)
.Cells(Ligne, 35) = Cells(C.Row, 35)
.Cells(Ligne, 36) = Cells(C.Row, 36)
.Cells(Ligne, 37) = Cells(C.Row, 37)
.Cells(Ligne, 38) = Cells(C.Row, 38)
.Cells(Ligne, 39) = Cells(C.Row, 39)
Ligne = Ligne + 1
End If
Next C
End If

Etc...

Pour le nom de la feuil c'est la meme chose etc

J'espere avoir ete explicite merci et malgres tout pas trop long !!!

--
IMER09






Avatar
IMER09
Je les ai enleves et je bug sur Sheets(ShDepart)
--
IMER09



Tu les enlèves tout simplement les Me. (n'oublie pas d'enlever le point aussi)


"IMER09" a écrit dans le message de news:

Bonsoir MichDenis
Je viens d'essayer les <> codes que tu m'avait fournit le premier fonctionne
tres bien j'ai meme reussi à alonger mon code ss Bug: ce n'etait donc pas les
If !!! Par contre le second ne fonctionne pas je bug tout d'abord sur
"Me." des CBB une fois les "Me" enlever je Bug sur Sheets(ShDepart) de la
sous procedure.
Quand à la troisieme partie : La premiere adapter ne bug pas mais aucun trie
ne se fait je ne vois pas pourquoi et je n'est pas essayé la deuxieme adapté

Merci pour ton aide ds l'attente à bientot
--
IMER09



| va régler mon pb de procedure trop longue,

Voici un bout de texte qui commente le poids que peut avoir
le code d'un module... malheureusement, je n'ai plu l'auteur
de ces lignes ...probablement, cette limite ne s'adresse pas
à la version Excel 2007

********************
"VBA has an undocumented "soft limit" on the maximum size of any single
standard code module. A standard code moldule should not exceed 64 KB as
measured by its text file size when exported from the project.Your
project will not crash immediately upon a single module exceeding this
64KB limit, but consistently exceeding this limit will almost invariably
lead to an unstable application."
********************

Et 64 Kb, c'est déjà beaucoup !

Je n'ai jamais rien vu ou lu quelque chose qui limiterait le nombre de
if ... Then dans une procédure ou une limitation quant au nombre
limite de lignes de code qu'une procédure peut contenir. (ceci ne
signifie pas que cela n'existe pas...)

Les messages précédents représentent simplement une autre façon d'écrire
le code mais d'une manière plus concise. (En supposant qu'elles fonctionnent
car elles n'ont pas été testées)... Est-ce que le code représente bien ce que
tu tentes de faire ? Ça c'est une autre question que je ne saurais répondre.




"IMER09" a écrit dans le message de news:

Merci MichDenis pour tout ce travail
Je n'est pas pu tester il se fait tard
Est ce que tu croix que le fait de racourcir:

.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4) etc

par

'Copie de la plage de cellule
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)).value= _
Range(Cells(C.Row, 1), Cells(C.Row, 39)).value
Ligne = Ligne + 1

va regler mon pb de procedure trop longue, j'avais l'impression que c'etait
plutot le nbr de If a la suite qui me rendait cette procedure trop longue.
Par contre ta seconde proposition m'enleve en effet un If a chaque fois soit
11 If, la piste me semble bonne.
Mais ne serait il pas possible de prendre en compte que les ComboBox
renseignés avant de faire le trie auquel cas je n'aurai plus qu'1 seule
partie et non plus 11, cela me laisssrai par la meme occasion la possibilté
d'ajoute des cas

J'espere mettre bien expliqué, merci encore
Je ne manquerai pas de te tenir au courant du resultat dès que j'aurai un
peu de temps pour tout remanier
--
IMER09



On peut même remplacer la boucle
For a = 39 dans la procédure proposée par
la première procédure par simplement
un copie d'une plage de cellules proposée
dans la deuxième procédure
'-------------------------
Sub Execution(Ligne As Long, Rg As Range)

With Sheets(ShDepart)
For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
For A = 1 To 39
.Cells(Ligne, A) = Cells(C.Row, A)
Next
Ligne = Ligne + 1
End If
Next
End With
End Sub
'-----------------------

par

'-------------------------
Sub Execution(Ligne As Long, Rg As Range)

With Sheets(ShDepart)
For Each C In Rg
Range(Cells(C.Row, 1), Cells(C.Row, 39)).Address
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
'Copie de la plage de cellule
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)).value= _
Range(Cells(C.Row, 1), Cells(C.Row, 39)).value
Ligne = Ligne + 1
End If
Next
End With
End Sub
'------------------------------

Dans la toute première procédure proposée, tu obtiendrais quelque chose dans le gennre :


Sub test()

Dim Ligne As Long, C As Range
Dim Rg As Range, A As Integer

Sheets("Archive").Select
With Sheets(ShDepart)
'CA TOTAL/1/1
If ComboBox1.Value <> "" And ComboBox2.Value = "" _
And ComboBox3.Value = "" And ComboBox4.Value = "" _
And ComboBox5.Value = "" And ComboBox6.Value = "" And _
.ComboBox7.Value <> "FAUX" And ComboBox8.Value = "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
Set Rg = Range("AJ4", Range("AJ65536").End(xlUp))

For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, -33) = Me.ComboBox1 Then
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)) = _
Range(Cells(C.Row, 1), Cells(C.Row, 39))
Ligne = Ligne + 1
End If
Next

'CA TOTAL/1/2
If ComboBox1.Value = "" And ComboBox2.Value <> "" _
And ComboBox3.Value = "" And ComboBox4.Value = "" _
And ComboBox5.Value = "" And ComboBox6.Value = "" _
And ComboBox7.Value <> "FAUX" And ComboBox8.Value = "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
Set Rg = Range("AJ4", Range("AJ65536").End(xlUp))

For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)) = _
Range(Cells(C.Row, 1), Cells(C.Row, 39))
Ligne = Ligne + 1
End If
Next
End If

End Sub
'----------------------






"IMER09" a écrit dans le message de news:

J'ai 8 Cobox ds un UF, chaque box recupere les criteres de 8 colonnes d'une
feuil archive qui comporte 39 colonnes
Avec un bouton valider je cree une feuil dont le non et une compilation des
CB renseigner je trie ensuite la feuille archive en fonction des criteres de
chaque CB que je colle ds ma new feuil cree(code ci dessous)
Pour finir je fait un certain nbre de calcul ds cette feuil cree
J'ai donc une macro tres longue que je voudrai encore agrandir
Le pb, je croix, est que mes CB n'ont pas forcement toute une valeur,
certaine reste blanche. J'ai donc du mettre ds mon code un nbr de If
important
Rien que pour le trie par ex j'ai 11 If qui corresponde a 11 critere de
trie possible

voici une partie de mon Code:

Sheets("Archive").Select
Dim Ligne As Long, C As Range
With Sheets(ShDepart)


'CA TOTAL/1/1
If ComboBox1.Value <> "" And ComboBox2.Value = "" And ComboBox3.Value = "" _
And ComboBox4.Value = "" And ComboBox5.Value = "" _
And ComboBox6.Value = "" And ComboBox7.Value <> "FAUX" And ComboBox8.Value > > > "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
For Each C In Range("AJ4", Range("AJ65536").End(xlUp))
If C = Me.ComboBox7 And C.Offset(, -33) = Me.ComboBox1 Then
.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4)
.Cells(Ligne, 5) = Cells(C.Row, 5)
.Cells(Ligne, 6) = Cells(C.Row, 6)
.Cells(Ligne, 7) = Cells(C.Row, 7)
.Cells(Ligne, 8) = Cells(C.Row, 8)
.Cells(Ligne, 9) = Cells(C.Row, 9)
.Cells(Ligne, 10) = Cells(C.Row, 10)
.Cells(Ligne, 11) = Cells(C.Row, 11)
.Cells(Ligne, 12) = Cells(C.Row, 12)
.Cells(Ligne, 13) = Cells(C.Row, 13)
.Cells(Ligne, 14) = Cells(C.Row, 14)
.Cells(Ligne, 15) = Cells(C.Row, 15)
.Cells(Ligne, 16) = Cells(C.Row, 16)
.Cells(Ligne, 17) = Cells(C.Row, 17)
.Cells(Ligne, 18) = Cells(C.Row, 18)
.Cells(Ligne, 19) = Cells(C.Row, 19)
.Cells(Ligne, 20) = Cells(C.Row, 20)
.Cells(Ligne, 21) = Cells(C.Row, 21)
.Cells(Ligne, 22) = Cells(C.Row, 22)
.Cells(Ligne, 23) = Cells(C.Row, 23)
.Cells(Ligne, 24) = Cells(C.Row, 24)
.Cells(Ligne, 25) = Cells(C.Row, 25)
.Cells(Ligne, 26) = Cells(C.Row, 26)
.Cells(Ligne, 27) = Cells(C.Row, 27)
.Cells(Ligne, 28) = Cells(C.Row, 28)
.Cells(Ligne, 29) = Cells(C.Row, 29)
.Cells(Ligne, 30) = Cells(C.Row, 30)
.Cells(Ligne, 31) = Cells(C.Row, 31)
.Cells(Ligne, 32) = Cells(C.Row, 32)
.Cells(Ligne, 33) = Cells(C.Row, 33)
.Cells(Ligne, 34) = Cells(C.Row, 34)
.Cells(Ligne, 35) = Cells(C.Row, 35)
.Cells(Ligne, 36) = Cells(C.Row, 36)
.Cells(Ligne, 37) = Cells(C.Row, 37)
.Cells(Ligne, 38) = Cells(C.Row, 38)
.Cells(Ligne, 39) = Cells(C.Row, 39)
Ligne = Ligne + 1
End If
Next C
End If


'CA TOTAL/1/2
If ComboBox1.Value = "" And ComboBox2.Value <> "" And ComboBox3.Value = "" _
And ComboBox4.Value = "" And ComboBox5.Value = "" _
And ComboBox6.Value = "" And ComboBox7.Value <> "FAUX" And ComboBox8.Value > > > "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
For Each C In Range("AJ4", Range("AJ65536").End(xlUp))
If C = Me.ComboBox7 _
And C.Offset(, 3) = Me.ComboBox2 Then
.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4)
.Cells(Ligne, 5) = Cells(C.Row, 5)
.Cells(Ligne, 6) = Cells(C.Row, 6)
.Cells(Ligne, 7) = Cells(C.Row, 7)
.Cells(Ligne, 8) = Cells(C.Row, 8)
.Cells(Ligne, 9) = Cells(C.Row, 9)
.Cells(Ligne, 10) = Cells(C.Row, 10)
.Cells(Ligne, 11) = Cells(C.Row, 11)
.Cells(Ligne, 12) = Cells(C.Row, 12)
.Cells(Ligne, 13) = Cells(C.Row, 13)
.Cells(Ligne, 14) = Cells(C.Row, 14)
.Cells(Ligne, 15) = Cells(C.Row, 15)
.Cells(Ligne, 16) = Cells(C.Row, 16)
.Cells(Ligne, 17) = Cells(C.Row, 17)
.Cells(Ligne, 18) = Cells(C.Row, 18)
.Cells(Ligne, 19) = Cells(C.Row, 19)
.Cells(Ligne, 20) = Cells(C.Row, 20)
.Cells(Ligne, 21) = Cells(C.Row, 21)
.Cells(Ligne, 22) = Cells(C.Row, 22)
.Cells(Ligne, 23) = Cells(C.Row, 23)
.Cells(Ligne, 24) = Cells(C.Row, 24)
.Cells(Ligne, 25) = Cells(C.Row, 25)
.Cells(Ligne, 26) = Cells(C.Row, 26)
.Cells(Ligne, 27) = Cells(C.Row, 27)
.Cells(Ligne, 28) = Cells(C.Row, 28)
.Cells(Ligne, 29) = Cells(C.Row, 29)
.Cells(Ligne, 30) = Cells(C.Row, 30)
.Cells(Ligne, 31) = Cells(C.Row, 31)
.Cells(Ligne, 32) = Cells(C.Row, 32)
.Cells(Ligne, 33) = Cells(C.Row, 33)






Avatar
MichDenis
| Je les ai enleves et je bug sur Sheets(ShDepart)

De quelle procédure parles-tu ? A quelle ligne ?

Écoute, je ne vais pas faire la correction d'une procédure d'une ligne
de code à la fois. Tu vas sûrement avoir besoin de perspicacité et de
sagacité pour comprendre le code et effectuer les corrections qui
s'imposent passer au travers. Comme je te l'ai dit, ces
procédures n'ont pas été testé car je n'ai pas l'environnement pour
les tester.

Vérifie sur la feuille existe, si elle bien orthographiée, est-elle accompagnée
d'un With ? Au delà de ça ...c'est ton job.

Ceci est ma dernière intervention sur ce fil :



"IMER09" a écrit dans le message de news:

Je les ai enleves et je bug sur Sheets(ShDepart)
--
IMER09



Tu les enlèves tout simplement les Me. (n'oublie pas d'enlever le point aussi)


"IMER09" a écrit dans le message de news:

Bonsoir MichDenis
Je viens d'essayer les <> codes que tu m'avait fournit le premier fonctionne
tres bien j'ai meme reussi à alonger mon code ss Bug: ce n'etait donc pas les
If !!! Par contre le second ne fonctionne pas je bug tout d'abord sur
"Me." des CBB une fois les "Me" enlever je Bug sur Sheets(ShDepart) de la
sous procedure.
Quand à la troisieme partie : La premiere adapter ne bug pas mais aucun trie
ne se fait je ne vois pas pourquoi et je n'est pas essayé la deuxieme adapté

Merci pour ton aide ds l'attente à bientot
--
IMER09



| va régler mon pb de procedure trop longue,

Voici un bout de texte qui commente le poids que peut avoir
le code d'un module... malheureusement, je n'ai plu l'auteur
de ces lignes ...probablement, cette limite ne s'adresse pas
à la version Excel 2007

********************
"VBA has an undocumented "soft limit" on the maximum size of any single
standard code module. A standard code moldule should not exceed 64 KB as
measured by its text file size when exported from the project.Your
project will not crash immediately upon a single module exceeding this
64KB limit, but consistently exceeding this limit will almost invariably
lead to an unstable application."
********************

Et 64 Kb, c'est déjà beaucoup !

Je n'ai jamais rien vu ou lu quelque chose qui limiterait le nombre de
if ... Then dans une procédure ou une limitation quant au nombre
limite de lignes de code qu'une procédure peut contenir. (ceci ne
signifie pas que cela n'existe pas...)

Les messages précédents représentent simplement une autre façon d'écrire
le code mais d'une manière plus concise. (En supposant qu'elles fonctionnent
car elles n'ont pas été testées)... Est-ce que le code représente bien ce que
tu tentes de faire ? Ça c'est une autre question que je ne saurais répondre.




"IMER09" a écrit dans le message de news:

Merci MichDenis pour tout ce travail
Je n'est pas pu tester il se fait tard
Est ce que tu croix que le fait de racourcir:

.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4) etc

par

'Copie de la plage de cellule
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)).value= _
Range(Cells(C.Row, 1), Cells(C.Row, 39)).value
Ligne = Ligne + 1

va regler mon pb de procedure trop longue, j'avais l'impression que c'etait
plutot le nbr de If a la suite qui me rendait cette procedure trop longue.
Par contre ta seconde proposition m'enleve en effet un If a chaque fois soit
11 If, la piste me semble bonne.
Mais ne serait il pas possible de prendre en compte que les ComboBox
renseignés avant de faire le trie auquel cas je n'aurai plus qu'1 seule
partie et non plus 11, cela me laisssrai par la meme occasion la possibilté
d'ajoute des cas

J'espere mettre bien expliqué, merci encore
Je ne manquerai pas de te tenir au courant du resultat dès que j'aurai un
peu de temps pour tout remanier
--
IMER09



On peut même remplacer la boucle
For a = 39 dans la procédure proposée par
la première procédure par simplement
un copie d'une plage de cellules proposée
dans la deuxième procédure
'-------------------------
Sub Execution(Ligne As Long, Rg As Range)

With Sheets(ShDepart)
For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
For A = 1 To 39
.Cells(Ligne, A) = Cells(C.Row, A)
Next
Ligne = Ligne + 1
End If
Next
End With
End Sub
'-----------------------

par

'-------------------------
Sub Execution(Ligne As Long, Rg As Range)

With Sheets(ShDepart)
For Each C In Rg
Range(Cells(C.Row, 1), Cells(C.Row, 39)).Address
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
'Copie de la plage de cellule
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)).value= _
Range(Cells(C.Row, 1), Cells(C.Row, 39)).value
Ligne = Ligne + 1
End If
Next
End With
End Sub
'------------------------------

Dans la toute première procédure proposée, tu obtiendrais quelque chose dans le gennre :


Sub test()

Dim Ligne As Long, C As Range
Dim Rg As Range, A As Integer

Sheets("Archive").Select
With Sheets(ShDepart)
'CA TOTAL/1/1
If ComboBox1.Value <> "" And ComboBox2.Value = "" _
And ComboBox3.Value = "" And ComboBox4.Value = "" _
And ComboBox5.Value = "" And ComboBox6.Value = "" And _
.ComboBox7.Value <> "FAUX" And ComboBox8.Value = "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
Set Rg = Range("AJ4", Range("AJ65536").End(xlUp))

For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, -33) = Me.ComboBox1 Then
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)) = _
Range(Cells(C.Row, 1), Cells(C.Row, 39))
Ligne = Ligne + 1
End If
Next

'CA TOTAL/1/2
If ComboBox1.Value = "" And ComboBox2.Value <> "" _
And ComboBox3.Value = "" And ComboBox4.Value = "" _
And ComboBox5.Value = "" And ComboBox6.Value = "" _
And ComboBox7.Value <> "FAUX" And ComboBox8.Value = "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
Set Rg = Range("AJ4", Range("AJ65536").End(xlUp))

For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)) = _
Range(Cells(C.Row, 1), Cells(C.Row, 39))
Ligne = Ligne + 1
End If
Next
End If

End Sub
'----------------------






"IMER09" a écrit dans le message de news:

J'ai 8 Cobox ds un UF, chaque box recupere les criteres de 8 colonnes d'une
feuil archive qui comporte 39 colonnes
Avec un bouton valider je cree une feuil dont le non et une compilation des
CB renseigner je trie ensuite la feuille archive en fonction des criteres de
chaque CB que je colle ds ma new feuil cree(code ci dessous)
Pour finir je fait un certain nbre de calcul ds cette feuil cree
J'ai donc une macro tres longue que je voudrai encore agrandir
Le pb, je croix, est que mes CB n'ont pas forcement toute une valeur,
certaine reste blanche. J'ai donc du mettre ds mon code un nbr de If
important
Rien que pour le trie par ex j'ai 11 If qui corresponde a 11 critere de
trie possible

voici une partie de mon Code:

Sheets("Archive").Select
Dim Ligne As Long, C As Range
With Sheets(ShDepart)


'CA TOTAL/1/1
If ComboBox1.Value <> "" And ComboBox2.Value = "" And ComboBox3.Value = "" _
And ComboBox4.Value = "" And ComboBox5.Value = "" _
And ComboBox6.Value = "" And ComboBox7.Value <> "FAUX" And ComboBox8.Value > > > "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
For Each C In Range("AJ4", Range("AJ65536").End(xlUp))
If C = Me.ComboBox7 And C.Offset(, -33) = Me.ComboBox1 Then
.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4)
.Cells(Ligne, 5) = Cells(C.Row, 5)
.Cells(Ligne, 6) = Cells(C.Row, 6)
.Cells(Ligne, 7) = Cells(C.Row, 7)
.Cells(Ligne, 8) = Cells(C.Row, 8)
.Cells(Ligne, 9) = Cells(C.Row, 9)
.Cells(Ligne, 10) = Cells(C.Row, 10)
.Cells(Ligne, 11) = Cells(C.Row, 11)
.Cells(Ligne, 12) = Cells(C.Row, 12)
.Cells(Ligne, 13) = Cells(C.Row, 13)
.Cells(Ligne, 14) = Cells(C.Row, 14)
.Cells(Ligne, 15) = Cells(C.Row, 15)
.Cells(Ligne, 16) = Cells(C.Row, 16)
.Cells(Ligne, 17) = Cells(C.Row, 17)
.Cells(Ligne, 18) = Cells(C.Row, 18)
.Cells(Ligne, 19) = Cells(C.Row, 19)
.Cells(Ligne, 20) = Cells(C.Row, 20)
.Cells(Ligne, 21) = Cells(C.Row, 21)
.Cells(Ligne, 22) = Cells(C.Row, 22)
.Cells(Ligne, 23) = Cells(C.Row, 23)
.Cells(Ligne, 24) = Cells(C.Row, 24)
.Cells(Ligne, 25) = Cells(C.Row, 25)
.Cells(Ligne, 26) = Cells(C.Row, 26)
.Cells(Ligne, 27) = Cells(C.Row, 27)
.Cells(Ligne, 28) = Cells(C.Row, 28)
.Cells(Ligne, 29) = Cells(C.Row, 29)
.Cells(Ligne, 30) = Cells(C.Row, 30)
.Cells(Ligne, 31) = Cells(C.Row, 31)
.Cells(Ligne, 32) = Cells(C.Row, 32)
.Cells(Ligne, 33) = Cells(C.Row, 33)
.Cells(Ligne, 34) = Cells(C.Row, 34)
.Cells(Ligne, 35) = Cells(C.Row, 35)
.Cells(Ligne, 36) = Cells(C.Row, 36)
.Cells(Ligne, 37) = Cells(C.Row, 37)
.Cells(Ligne, 38) = Cells(C.Row, 38)
.Cells(Ligne, 39) = Cells(C.Row, 39)
Ligne = Ligne + 1
End If
Next C
End If


'CA TOTAL/1/2
If ComboBox1.Value = "" And ComboBox2.Value <> "" And ComboBox3.Value = "" _
And ComboBox4.Value = "" And ComboBox5.Value = "" _
And ComboBox6.Value = "" And ComboBox7.Value <> "FAUX" And ComboBox8.Value > > > "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
For Each C In Range("AJ4", Range("AJ65536").End(xlUp))
If C = Me.ComboBox7 _
And C.Offset(, 3) = Me.ComboBox2 Then
.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4)
.Cells(Ligne, 5) = Cells(C.Row, 5)
.Cells(Ligne, 6) = Cells(C.Row, 6)
.Cells(Ligne, 7) = Cells(C.Row, 7)
.Cells(Ligne, 8) = Cells(C.Row, 8)
.Cells(Ligne, 9) = Cells(C.Row, 9)
.Cells(Ligne, 10) = Cells(C.Row, 10)
.Cells(Ligne, 11) = Cells(C.Row, 11)
.Cells(Ligne, 12) = Cells(C.Row, 12)
.Cells(Ligne, 13) = Cells(C.Row, 13)
.Cells(Ligne, 14) = Cells(C.Row, 14)
.Cells(Ligne, 15) = Cells(C.Row, 15)
.Cells(Ligne, 16) = Cells(C.Row, 16)
.Cells(Ligne, 17) = Cells(C.Row, 17)
.Cells(Ligne, 18) = Cells(C.Row, 18)
.Cells(Ligne, 19) = Cells(C.Row, 19)
.Cells(Ligne, 20) = Cells(C.Row, 20)
.Cells(Ligne, 21) = Cells(C.Row, 21)
.Cells(Ligne, 22) = Cells(C.Row, 22)
.Cells(Ligne, 23) = Cells(C.Row, 23)
.Cells(Ligne, 24) = Cells(C.Row, 24)
.Cells(Ligne, 25) = Cells(C.Row, 25)
.Cells(Ligne, 26) = Cells(C.Row, 26)
.Cells(Ligne, 27) = Cells(C.Row, 27)
.Cells(Ligne, 28) = Cells(C.Row, 28)
.Cells(Ligne, 29) = Cells(C.Row, 29)
.Cells(Ligne, 30) = Cells(C.Row, 30)
.Cells(Ligne, 31) = Cells(C.Row, 31)
.Cells(Ligne, 32) = Cells(C.Row, 32)
.Cells(Ligne, 33) = Cells(C.Row, 33)






Avatar
IMER09
Excuse moi d'abuser de ta patience
Ta premiere reponse ma apporté ce qu'il me fallait, racourcir le code a
suffit pour eviter le message procedure trop longue et je t' en remerci
Pour la suite je cherchais simplement a comprendre comment executer une
procedure placé ds un modul, comme me l'avait preconisé Misange et comme tu
me le preconisé ds ton second message, pour mon enrichissement personnel
Mais j'ai manifestement abusé
Desolé pour mon incompetence
A bientot quand meme j'espere--
IMER09




| Je les ai enleves et je bug sur Sheets(ShDepart)

De quelle procédure parles-tu ? A quelle ligne ?

Écoute, je ne vais pas faire la correction d'une procédure d'une ligne
de code à la fois. Tu vas sûrement avoir besoin de perspicacité et de
sagacité pour comprendre le code et effectuer les corrections qui
s'imposent passer au travers. Comme je te l'ai dit, ces
procédures n'ont pas été testé car je n'ai pas l'environnement pour
les tester.

Vérifie sur la feuille existe, si elle bien orthographiée, est-elle accompagnée
d'un With ? Au delà de ça ...c'est ton job.

Ceci est ma dernière intervention sur ce fil :



"IMER09" a écrit dans le message de news:

Je les ai enleves et je bug sur Sheets(ShDepart)
--
IMER09



Tu les enlèves tout simplement les Me. (n'oublie pas d'enlever le point aussi)


"IMER09" a écrit dans le message de news:

Bonsoir MichDenis
Je viens d'essayer les <> codes que tu m'avait fournit le premier fonctionne
tres bien j'ai meme reussi à alonger mon code ss Bug: ce n'etait donc pas les
If !!! Par contre le second ne fonctionne pas je bug tout d'abord sur
"Me." des CBB une fois les "Me" enlever je Bug sur Sheets(ShDepart) de la
sous procedure.
Quand à la troisieme partie : La premiere adapter ne bug pas mais aucun trie
ne se fait je ne vois pas pourquoi et je n'est pas essayé la deuxieme adapté

Merci pour ton aide ds l'attente à bientot
--
IMER09



| va régler mon pb de procedure trop longue,

Voici un bout de texte qui commente le poids que peut avoir
le code d'un module... malheureusement, je n'ai plu l'auteur
de ces lignes ...probablement, cette limite ne s'adresse pas
à la version Excel 2007

********************
"VBA has an undocumented "soft limit" on the maximum size of any single
standard code module. A standard code moldule should not exceed 64 KB as
measured by its text file size when exported from the project.Your
project will not crash immediately upon a single module exceeding this
64KB limit, but consistently exceeding this limit will almost invariably
lead to an unstable application."
********************

Et 64 Kb, c'est déjà beaucoup !

Je n'ai jamais rien vu ou lu quelque chose qui limiterait le nombre de
if ... Then dans une procédure ou une limitation quant au nombre
limite de lignes de code qu'une procédure peut contenir. (ceci ne
signifie pas que cela n'existe pas...)

Les messages précédents représentent simplement une autre façon d'écrire
le code mais d'une manière plus concise. (En supposant qu'elles fonctionnent
car elles n'ont pas été testées)... Est-ce que le code représente bien ce que
tu tentes de faire ? Ça c'est une autre question que je ne saurais répondre.




"IMER09" a écrit dans le message de news:

Merci MichDenis pour tout ce travail
Je n'est pas pu tester il se fait tard
Est ce que tu croix que le fait de racourcir:

.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4) etc

par

'Copie de la plage de cellule
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)).value= _
Range(Cells(C.Row, 1), Cells(C.Row, 39)).value
Ligne = Ligne + 1

va regler mon pb de procedure trop longue, j'avais l'impression que c'etait
plutot le nbr de If a la suite qui me rendait cette procedure trop longue.
Par contre ta seconde proposition m'enleve en effet un If a chaque fois soit
11 If, la piste me semble bonne.
Mais ne serait il pas possible de prendre en compte que les ComboBox
renseignés avant de faire le trie auquel cas je n'aurai plus qu'1 seule
partie et non plus 11, cela me laisssrai par la meme occasion la possibilté
d'ajoute des cas

J'espere mettre bien expliqué, merci encore
Je ne manquerai pas de te tenir au courant du resultat dès que j'aurai un
peu de temps pour tout remanier
--
IMER09



On peut même remplacer la boucle
For a = 39 dans la procédure proposée par
la première procédure par simplement
un copie d'une plage de cellules proposée
dans la deuxième procédure
'-------------------------
Sub Execution(Ligne As Long, Rg As Range)

With Sheets(ShDepart)
For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
For A = 1 To 39
.Cells(Ligne, A) = Cells(C.Row, A)
Next
Ligne = Ligne + 1
End If
Next
End With
End Sub
'-----------------------

par

'-------------------------
Sub Execution(Ligne As Long, Rg As Range)

With Sheets(ShDepart)
For Each C In Rg
Range(Cells(C.Row, 1), Cells(C.Row, 39)).Address
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
'Copie de la plage de cellule
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)).value= _
Range(Cells(C.Row, 1), Cells(C.Row, 39)).value
Ligne = Ligne + 1
End If
Next
End With
End Sub
'------------------------------

Dans la toute première procédure proposée, tu obtiendrais quelque chose dans le gennre :


Sub test()

Dim Ligne As Long, C As Range
Dim Rg As Range, A As Integer

Sheets("Archive").Select
With Sheets(ShDepart)
'CA TOTAL/1/1
If ComboBox1.Value <> "" And ComboBox2.Value = "" _
And ComboBox3.Value = "" And ComboBox4.Value = "" _
And ComboBox5.Value = "" And ComboBox6.Value = "" And _
.ComboBox7.Value <> "FAUX" And ComboBox8.Value = "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
Set Rg = Range("AJ4", Range("AJ65536").End(xlUp))

For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, -33) = Me.ComboBox1 Then
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)) = _
Range(Cells(C.Row, 1), Cells(C.Row, 39))
Ligne = Ligne + 1
End If
Next

'CA TOTAL/1/2
If ComboBox1.Value = "" And ComboBox2.Value <> "" _
And ComboBox3.Value = "" And ComboBox4.Value = "" _
And ComboBox5.Value = "" And ComboBox6.Value = "" _
And ComboBox7.Value <> "FAUX" And ComboBox8.Value = "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
Set Rg = Range("AJ4", Range("AJ65536").End(xlUp))

For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)) = _
Range(Cells(C.Row, 1), Cells(C.Row, 39))
Ligne = Ligne + 1
End If
Next
End If

End Sub
'----------------------






"IMER09" a écrit dans le message de news:

J'ai 8 Cobox ds un UF, chaque box recupere les criteres de 8 colonnes d'une
feuil archive qui comporte 39 colonnes
Avec un bouton valider je cree une feuil dont le non et une compilation des
CB renseigner je trie ensuite la feuille archive en fonction des criteres de
chaque CB que je colle ds ma new feuil cree(code ci dessous)
Pour finir je fait un certain nbre de calcul ds cette feuil cree
J'ai donc une macro tres longue que je voudrai encore agrandir
Le pb, je croix, est que mes CB n'ont pas forcement toute une valeur,
certaine reste blanche. J'ai donc du mettre ds mon code un nbr de If
important
Rien que pour le trie par ex j'ai 11 If qui corresponde a 11 critere de
trie possible

voici une partie de mon Code:

Sheets("Archive").Select
Dim Ligne As Long, C As Range
With Sheets(ShDepart)


'CA TOTAL/1/1
If ComboBox1.Value <> "" And ComboBox2.Value = "" And ComboBox3.Value = "" _
And ComboBox4.Value = "" And ComboBox5.Value = "" _
And ComboBox6.Value = "" And ComboBox7.Value <> "FAUX" And ComboBox8.Value > > > > "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
For Each C In Range("AJ4", Range("AJ65536").End(xlUp))
If C = Me.ComboBox7 And C.Offset(, -33) = Me.ComboBox1 Then
.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4)
.Cells(Ligne, 5) = Cells(C.Row, 5)
.Cells(Ligne, 6) = Cells(C.Row, 6)
.Cells(Ligne, 7) = Cells(C.Row, 7)
.Cells(Ligne, 8) = Cells(C.Row, 8)
.Cells(Ligne, 9) = Cells(C.Row, 9)
.Cells(Ligne, 10) = Cells(C.Row, 10)
.Cells(Ligne, 11) = Cells(C.Row, 11)
.Cells(Ligne, 12) = Cells(C.Row, 12)
.Cells(Ligne, 13) = Cells(C.Row, 13)
.Cells(Ligne, 14) = Cells(C.Row, 14)
.Cells(Ligne, 15) = Cells(C.Row, 15)
.Cells(Ligne, 16) = Cells(C.Row, 16)
.Cells(Ligne, 17) = Cells(C.Row, 17)
.Cells(Ligne, 18) = Cells(C.Row, 18)
.Cells(Ligne, 19) = Cells(C.Row, 19)
.Cells(Ligne, 20) = Cells(C.Row, 20)
.Cells(Ligne, 21) = Cells(C.Row, 21)
.Cells(Ligne, 22) = Cells(C.Row, 22)
.Cells(Ligne, 23) = Cells(C.Row, 23)
.Cells(Ligne, 24) = Cells(C.Row, 24)
.Cells(Ligne, 25) = Cells(C.Row, 25)
.Cells(Ligne, 26) = Cells(C.Row, 26)
.Cells(Ligne, 27) = Cells(C.Row, 27)
.Cells(Ligne, 28) = Cells(C.Row, 28)
.Cells(Ligne, 29) = Cells(C.Row, 29)
.Cells(Ligne, 30) = Cells(C.Row, 30)
.Cells(Ligne, 31) = Cells(C.Row, 31)
.Cells(Ligne, 32) = Cells(C.Row, 32)
.Cells(Ligne, 33) = Cells(C.Row, 33)
.Cells(Ligne, 34) = Cells(C.Row, 34)
.Cells(Ligne, 35) = Cells(C.Row, 35)
.Cells(Ligne, 36) = Cells(C.Row, 36)
.Cells(Ligne, 37) = Cells(C.Row, 37)
.Cells(Ligne, 38) = Cells(C.Row, 38)
.Cells(Ligne, 39) = Cells(C.Row, 39)
Ligne = Ligne + 1
End If
Next C
End If


'CA TOTAL/1/2
If ComboBox1.Value = "" And ComboBox2.Value <> "" And ComboBox3.Value = "" _
And ComboBox4.Value = "" And ComboBox5.Value = "" _
And ComboBox6.Value = "" And ComboBox7.Value <> "FAUX" And ComboBox8.Value > > > > "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
For Each C In Range("AJ4", Range("AJ65536").End(xlUp))
If C = Me.ComboBox7 _
And C.Offset(, 3) = Me.ComboBox2 Then
.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4)
.Cells(Ligne, 5) = Cells(C.Row, 5)
.Cells(Ligne, 6) = Cells(C.Row, 6)








Avatar
MichDenis
Mon commentaire n'avait rien à voir avec "l'abus"

Sauf que pour "débugger" une procédure lorsque l'on ne possède pas
l'application sous les yeux n'est pas évident !

Exemple : Lorsque tu as mentionné que la procédure buggait sur "Me"
si tu m'avais dit que tu avais déplacé la procédure dans un module
standard, je t'aurais dit de remplacer le mot Me par Userform1 (ou
le nom du formulaire concerné) à la place, je t'ai dit d'enlever l'expresson Me.

Au même titre lorsque tu me dis que tu as un problème avec "Sheets(ShDepart)"
comment je peux faire pour avoir l'information manquante à ton commentaire ?
De quelle procédure ? De quelle ligne de code ? As-tu fais des modifications
au code ? l'as-tu changé de place ? ....

Ceci est susceptible de générer un fil qui ressemble plus à du "chatting" qu'à une
échange d'informations sur un sujet précis. Le "Chatting", je n'aime pas vraiment.

En dernier lieu, lorsque tu passes de la procédure1 à la procédure2, à la procédure3
le niveau de difficulté augmente au niveau de la compréhension et du "débogage".
J'en suis bien conscient.... Si tu veux comprendre et tester les 3 procédures, si tu
es débutant...il faudra que tu y consacres quand même pas mal de temps, temps
que tu n'as peut être pas ....mais ça, ce n'est pas mon problème.

Je ne refuse pas de répondre aux questions, encore, faut-il que je sois en situation
pour le faire.





"IMER09" a écrit dans le message de news:

Excuse moi d'abuser de ta patience
Ta premiere reponse ma apporté ce qu'il me fallait, racourcir le code a
suffit pour eviter le message procedure trop longue et je t' en remerci
Pour la suite je cherchais simplement a comprendre comment executer une
procedure placé ds un modul, comme me l'avait preconisé Misange et comme tu
me le preconisé ds ton second message, pour mon enrichissement personnel
Mais j'ai manifestement abusé
Desolé pour mon incompetence
A bientot quand meme j'espere--
IMER09




| Je les ai enleves et je bug sur Sheets(ShDepart)

De quelle procédure parles-tu ? A quelle ligne ?

Écoute, je ne vais pas faire la correction d'une procédure d'une ligne
de code à la fois. Tu vas sûrement avoir besoin de perspicacité et de
sagacité pour comprendre le code et effectuer les corrections qui
s'imposent passer au travers. Comme je te l'ai dit, ces
procédures n'ont pas été testé car je n'ai pas l'environnement pour
les tester.

Vérifie sur la feuille existe, si elle bien orthographiée, est-elle accompagnée
d'un With ? Au delà de ça ...c'est ton job.

Ceci est ma dernière intervention sur ce fil :



"IMER09" a écrit dans le message de news:

Je les ai enleves et je bug sur Sheets(ShDepart)
--
IMER09



Tu les enlèves tout simplement les Me. (n'oublie pas d'enlever le point aussi)


"IMER09" a écrit dans le message de news:

Bonsoir MichDenis
Je viens d'essayer les <> codes que tu m'avait fournit le premier fonctionne
tres bien j'ai meme reussi à alonger mon code ss Bug: ce n'etait donc pas les
If !!! Par contre le second ne fonctionne pas je bug tout d'abord sur
"Me." des CBB une fois les "Me" enlever je Bug sur Sheets(ShDepart) de la
sous procedure.
Quand à la troisieme partie : La premiere adapter ne bug pas mais aucun trie
ne se fait je ne vois pas pourquoi et je n'est pas essayé la deuxieme adapté

Merci pour ton aide ds l'attente à bientot
--
IMER09



| va régler mon pb de procedure trop longue,

Voici un bout de texte qui commente le poids que peut avoir
le code d'un module... malheureusement, je n'ai plu l'auteur
de ces lignes ...probablement, cette limite ne s'adresse pas
à la version Excel 2007

********************
"VBA has an undocumented "soft limit" on the maximum size of any single
standard code module. A standard code moldule should not exceed 64 KB as
measured by its text file size when exported from the project.Your
project will not crash immediately upon a single module exceeding this
64KB limit, but consistently exceeding this limit will almost invariably
lead to an unstable application."
********************

Et 64 Kb, c'est déjà beaucoup !

Je n'ai jamais rien vu ou lu quelque chose qui limiterait le nombre de
if ... Then dans une procédure ou une limitation quant au nombre
limite de lignes de code qu'une procédure peut contenir. (ceci ne
signifie pas que cela n'existe pas...)

Les messages précédents représentent simplement une autre façon d'écrire
le code mais d'une manière plus concise. (En supposant qu'elles fonctionnent
car elles n'ont pas été testées)... Est-ce que le code représente bien ce que
tu tentes de faire ? Ça c'est une autre question que je ne saurais répondre.




"IMER09" a écrit dans le message de news:

Merci MichDenis pour tout ce travail
Je n'est pas pu tester il se fait tard
Est ce que tu croix que le fait de racourcir:

.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4) etc

par

'Copie de la plage de cellule
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)).value= _
Range(Cells(C.Row, 1), Cells(C.Row, 39)).value
Ligne = Ligne + 1

va regler mon pb de procedure trop longue, j'avais l'impression que c'etait
plutot le nbr de If a la suite qui me rendait cette procedure trop longue.
Par contre ta seconde proposition m'enleve en effet un If a chaque fois soit
11 If, la piste me semble bonne.
Mais ne serait il pas possible de prendre en compte que les ComboBox
renseignés avant de faire le trie auquel cas je n'aurai plus qu'1 seule
partie et non plus 11, cela me laisssrai par la meme occasion la possibilté
d'ajoute des cas

J'espere mettre bien expliqué, merci encore
Je ne manquerai pas de te tenir au courant du resultat dès que j'aurai un
peu de temps pour tout remanier
--
IMER09



On peut même remplacer la boucle
For a = 39 dans la procédure proposée par
la première procédure par simplement
un copie d'une plage de cellules proposée
dans la deuxième procédure
'-------------------------
Sub Execution(Ligne As Long, Rg As Range)

With Sheets(ShDepart)
For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
For A = 1 To 39
.Cells(Ligne, A) = Cells(C.Row, A)
Next
Ligne = Ligne + 1
End If
Next
End With
End Sub
'-----------------------

par

'-------------------------
Sub Execution(Ligne As Long, Rg As Range)

With Sheets(ShDepart)
For Each C In Rg
Range(Cells(C.Row, 1), Cells(C.Row, 39)).Address
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
'Copie de la plage de cellule
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)).value= _
Range(Cells(C.Row, 1), Cells(C.Row, 39)).value
Ligne = Ligne + 1
End If
Next
End With
End Sub
'------------------------------

Dans la toute première procédure proposée, tu obtiendrais quelque chose dans le gennre :


Sub test()

Dim Ligne As Long, C As Range
Dim Rg As Range, A As Integer

Sheets("Archive").Select
With Sheets(ShDepart)
'CA TOTAL/1/1
If ComboBox1.Value <> "" And ComboBox2.Value = "" _
And ComboBox3.Value = "" And ComboBox4.Value = "" _
And ComboBox5.Value = "" And ComboBox6.Value = "" And _
.ComboBox7.Value <> "FAUX" And ComboBox8.Value = "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
Set Rg = Range("AJ4", Range("AJ65536").End(xlUp))

For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, -33) = Me.ComboBox1 Then
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)) = _
Range(Cells(C.Row, 1), Cells(C.Row, 39))
Ligne = Ligne + 1
End If
Next

'CA TOTAL/1/2
If ComboBox1.Value = "" And ComboBox2.Value <> "" _
And ComboBox3.Value = "" And ComboBox4.Value = "" _
And ComboBox5.Value = "" And ComboBox6.Value = "" _
And ComboBox7.Value <> "FAUX" And ComboBox8.Value = "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
Set Rg = Range("AJ4", Range("AJ65536").End(xlUp))

For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)) = _
Range(Cells(C.Row, 1), Cells(C.Row, 39))
Ligne = Ligne + 1
End If
Next
End If

End Sub
'----------------------






"IMER09" a écrit dans le message de news:

J'ai 8 Cobox ds un UF, chaque box recupere les criteres de 8 colonnes d'une
feuil archive qui comporte 39 colonnes
Avec un bouton valider je cree une feuil dont le non et une compilation des
CB renseigner je trie ensuite la feuille archive en fonction des criteres de
chaque CB que je colle ds ma new feuil cree(code ci dessous)
Pour finir je fait un certain nbre de calcul ds cette feuil cree
J'ai donc une macro tres longue que je voudrai encore agrandir
Le pb, je croix, est que mes CB n'ont pas forcement toute une valeur,
certaine reste blanche. J'ai donc du mettre ds mon code un nbr de If
important
Rien que pour le trie par ex j'ai 11 If qui corresponde a 11 critere de
trie possible

voici une partie de mon Code:

Sheets("Archive").Select
Dim Ligne As Long, C As Range
With Sheets(ShDepart)


'CA TOTAL/1/1
If ComboBox1.Value <> "" And ComboBox2.Value = "" And ComboBox3.Value = "" _
And ComboBox4.Value = "" And ComboBox5.Value = "" _
And ComboBox6.Value = "" And ComboBox7.Value <> "FAUX" And ComboBox8.Value > > > > "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
For Each C In Range("AJ4", Range("AJ65536").End(xlUp))
If C = Me.ComboBox7 And C.Offset(, -33) = Me.ComboBox1 Then
.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4)
.Cells(Ligne, 5) = Cells(C.Row, 5)
.Cells(Ligne, 6) = Cells(C.Row, 6)
.Cells(Ligne, 7) = Cells(C.Row, 7)
.Cells(Ligne, 8) = Cells(C.Row, 8)
.Cells(Ligne, 9) = Cells(C.Row, 9)
.Cells(Ligne, 10) = Cells(C.Row, 10)
.Cells(Ligne, 11) = Cells(C.Row, 11)
.Cells(Ligne, 12) = Cells(C.Row, 12)
.Cells(Ligne, 13) = Cells(C.Row, 13)
.Cells(Ligne, 14) = Cells(C.Row, 14)
.Cells(Ligne, 15) = Cells(C.Row, 15)
.Cells(Ligne, 16) = Cells(C.Row, 16)
.Cells(Ligne, 17) = Cells(C.Row, 17)
.Cells(Ligne, 18) = Cells(C.Row, 18)
.Cells(Ligne, 19) = Cells(C.Row, 19)
.Cells(Ligne, 20) = Cells(C.Row, 20)
.Cells(Ligne, 21) = Cells(C.Row, 21)
.Cells(Ligne, 22) = Cells(C.Row, 22)
.Cells(Ligne, 23) = Cells(C.Row, 23)
.Cells(Ligne, 24) = Cells(C.Row, 24)
.Cells(Ligne, 25) = Cells(C.Row, 25)
.Cells(Ligne, 26) = Cells(C.Row, 26)
.Cells(Ligne, 27) = Cells(C.Row, 27)
.Cells(Ligne, 28) = Cells(C.Row, 28)
.Cells(Ligne, 29) = Cells(C.Row, 29)
.Cells(Ligne, 30) = Cells(C.Row, 30)
.Cells(Ligne, 31) = Cells(C.Row, 31)
.Cells(Ligne, 32) = Cells(C.Row, 32)
.Cells(Ligne, 33) = Cells(C.Row, 33)
.Cells(Ligne, 34) = Cells(C.Row, 34)
.Cells(Ligne, 35) = Cells(C.Row, 35)
.Cells(Ligne, 36) = Cells(C.Row, 36)
.Cells(Ligne, 37) = Cells(C.Row, 37)
.Cells(Ligne, 38) = Cells(C.Row, 38)
.Cells(Ligne, 39) = Cells(C.Row, 39)
Ligne = Ligne + 1
End If
Next C
End If


'CA TOTAL/1/2
If ComboBox1.Value = "" And ComboBox2.Value <> "" And ComboBox3.Value = "" _
And ComboBox4.Value = "" And ComboBox5.Value = "" _
And ComboBox6.Value = "" And ComboBox7.Value <> "FAUX" And ComboBox8.Value > > > > "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
For Each C In Range("AJ4", Range("AJ65536").End(xlUp))
If C = Me.ComboBox7 _
And C.Offset(, 3) = Me.ComboBox2 Then
.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4)
.Cells(Ligne, 5) = Cells(C.Row, 5)
.Cells(Ligne, 6) = Cells(C.Row, 6)








Avatar
IMER09
OK message bien reçu
--
IMER09



Mon commentaire n'avait rien à voir avec "l'abus"

Sauf que pour "débugger" une procédure lorsque l'on ne possède pas
l'application sous les yeux n'est pas évident !

Exemple : Lorsque tu as mentionné que la procédure buggait sur "Me"
si tu m'avais dit que tu avais déplacé la procédure dans un module
standard, je t'aurais dit de remplacer le mot Me par Userform1 (ou
le nom du formulaire concerné) à la place, je t'ai dit d'enlever l'expresson Me.

Au même titre lorsque tu me dis que tu as un problème avec "Sheets(ShDepart)"
comment je peux faire pour avoir l'information manquante à ton commentaire ?
De quelle procédure ? De quelle ligne de code ? As-tu fais des modifications
au code ? l'as-tu changé de place ? ....

Ceci est susceptible de générer un fil qui ressemble plus à du "chatting" qu'à une
échange d'informations sur un sujet précis. Le "Chatting", je n'aime pas vraiment.

En dernier lieu, lorsque tu passes de la procédure1 à la procédure2, à la procédure3
le niveau de difficulté augmente au niveau de la compréhension et du "débogage".
J'en suis bien conscient.... Si tu veux comprendre et tester les 3 procédures, si tu
es débutant...il faudra que tu y consacres quand même pas mal de temps, temps
que tu n'as peut être pas ....mais ça, ce n'est pas mon problème.

Je ne refuse pas de répondre aux questions, encore, faut-il que je sois en situation
pour le faire.





"IMER09" a écrit dans le message de news:

Excuse moi d'abuser de ta patience
Ta premiere reponse ma apporté ce qu'il me fallait, racourcir le code a
suffit pour eviter le message procedure trop longue et je t' en remerci
Pour la suite je cherchais simplement a comprendre comment executer une
procedure placé ds un modul, comme me l'avait preconisé Misange et comme tu
me le preconisé ds ton second message, pour mon enrichissement personnel
Mais j'ai manifestement abusé
Desolé pour mon incompetence
A bientot quand meme j'espere--
IMER09




| Je les ai enleves et je bug sur Sheets(ShDepart)

De quelle procédure parles-tu ? A quelle ligne ?

Écoute, je ne vais pas faire la correction d'une procédure d'une ligne
de code à la fois. Tu vas sûrement avoir besoin de perspicacité et de
sagacité pour comprendre le code et effectuer les corrections qui
s'imposent passer au travers. Comme je te l'ai dit, ces
procédures n'ont pas été testé car je n'ai pas l'environnement pour
les tester.

Vérifie sur la feuille existe, si elle bien orthographiée, est-elle accompagnée
d'un With ? Au delà de ça ...c'est ton job.

Ceci est ma dernière intervention sur ce fil :



"IMER09" a écrit dans le message de news:

Je les ai enleves et je bug sur Sheets(ShDepart)
--
IMER09



Tu les enlèves tout simplement les Me. (n'oublie pas d'enlever le point aussi)


"IMER09" a écrit dans le message de news:

Bonsoir MichDenis
Je viens d'essayer les <> codes que tu m'avait fournit le premier fonctionne
tres bien j'ai meme reussi à alonger mon code ss Bug: ce n'etait donc pas les
If !!! Par contre le second ne fonctionne pas je bug tout d'abord sur
"Me." des CBB une fois les "Me" enlever je Bug sur Sheets(ShDepart) de la
sous procedure.
Quand à la troisieme partie : La premiere adapter ne bug pas mais aucun trie
ne se fait je ne vois pas pourquoi et je n'est pas essayé la deuxieme adapté

Merci pour ton aide ds l'attente à bientot
--
IMER09



| va régler mon pb de procedure trop longue,

Voici un bout de texte qui commente le poids que peut avoir
le code d'un module... malheureusement, je n'ai plu l'auteur
de ces lignes ...probablement, cette limite ne s'adresse pas
à la version Excel 2007

********************
"VBA has an undocumented "soft limit" on the maximum size of any single
standard code module. A standard code moldule should not exceed 64 KB as
measured by its text file size when exported from the project.Your
project will not crash immediately upon a single module exceeding this
64KB limit, but consistently exceeding this limit will almost invariably
lead to an unstable application."
********************

Et 64 Kb, c'est déjà beaucoup !

Je n'ai jamais rien vu ou lu quelque chose qui limiterait le nombre de
if ... Then dans une procédure ou une limitation quant au nombre
limite de lignes de code qu'une procédure peut contenir. (ceci ne
signifie pas que cela n'existe pas...)

Les messages précédents représentent simplement une autre façon d'écrire
le code mais d'une manière plus concise. (En supposant qu'elles fonctionnent
car elles n'ont pas été testées)... Est-ce que le code représente bien ce que
tu tentes de faire ? Ça c'est une autre question que je ne saurais répondre.




"IMER09" a écrit dans le message de news:

Merci MichDenis pour tout ce travail
Je n'est pas pu tester il se fait tard
Est ce que tu croix que le fait de racourcir:

.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4) etc

par

'Copie de la plage de cellule
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)).value= _
Range(Cells(C.Row, 1), Cells(C.Row, 39)).value
Ligne = Ligne + 1

va regler mon pb de procedure trop longue, j'avais l'impression que c'etait
plutot le nbr de If a la suite qui me rendait cette procedure trop longue.
Par contre ta seconde proposition m'enleve en effet un If a chaque fois soit
11 If, la piste me semble bonne.
Mais ne serait il pas possible de prendre en compte que les ComboBox
renseignés avant de faire le trie auquel cas je n'aurai plus qu'1 seule
partie et non plus 11, cela me laisssrai par la meme occasion la possibilté
d'ajoute des cas

J'espere mettre bien expliqué, merci encore
Je ne manquerai pas de te tenir au courant du resultat dès que j'aurai un
peu de temps pour tout remanier
--
IMER09



On peut même remplacer la boucle
For a = 39 dans la procédure proposée par
la première procédure par simplement
un copie d'une plage de cellules proposée
dans la deuxième procédure
'-------------------------
Sub Execution(Ligne As Long, Rg As Range)

With Sheets(ShDepart)
For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
For A = 1 To 39
.Cells(Ligne, A) = Cells(C.Row, A)
Next
Ligne = Ligne + 1
End If
Next
End With
End Sub
'-----------------------

par

'-------------------------
Sub Execution(Ligne As Long, Rg As Range)

With Sheets(ShDepart)
For Each C In Rg
Range(Cells(C.Row, 1), Cells(C.Row, 39)).Address
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
'Copie de la plage de cellule
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)).value= _
Range(Cells(C.Row, 1), Cells(C.Row, 39)).value
Ligne = Ligne + 1
End If
Next
End With
End Sub
'------------------------------

Dans la toute première procédure proposée, tu obtiendrais quelque chose dans le gennre :


Sub test()

Dim Ligne As Long, C As Range
Dim Rg As Range, A As Integer

Sheets("Archive").Select
With Sheets(ShDepart)
'CA TOTAL/1/1
If ComboBox1.Value <> "" And ComboBox2.Value = "" _
And ComboBox3.Value = "" And ComboBox4.Value = "" _
And ComboBox5.Value = "" And ComboBox6.Value = "" And _
.ComboBox7.Value <> "FAUX" And ComboBox8.Value = "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
Set Rg = Range("AJ4", Range("AJ65536").End(xlUp))

For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, -33) = Me.ComboBox1 Then
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)) = _
Range(Cells(C.Row, 1), Cells(C.Row, 39))
Ligne = Ligne + 1
End If
Next

'CA TOTAL/1/2
If ComboBox1.Value = "" And ComboBox2.Value <> "" _
And ComboBox3.Value = "" And ComboBox4.Value = "" _
And ComboBox5.Value = "" And ComboBox6.Value = "" _
And ComboBox7.Value <> "FAUX" And ComboBox8.Value = "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
Set Rg = Range("AJ4", Range("AJ65536").End(xlUp))

For Each C In Rg
If C = Me.ComboBox7 And C.Offset(, 3) = Me.ComboBox2 Then
.Range(.Cells(Ligne, 1), .Cells(Ligne, 39)) = _
Range(Cells(C.Row, 1), Cells(C.Row, 39))
Ligne = Ligne + 1
End If
Next
End If

End Sub
'----------------------






"IMER09" a écrit dans le message de news:

J'ai 8 Cobox ds un UF, chaque box recupere les criteres de 8 colonnes d'une
feuil archive qui comporte 39 colonnes
Avec un bouton valider je cree une feuil dont le non et une compilation des
CB renseigner je trie ensuite la feuille archive en fonction des criteres de
chaque CB que je colle ds ma new feuil cree(code ci dessous)
Pour finir je fait un certain nbre de calcul ds cette feuil cree
J'ai donc une macro tres longue que je voudrai encore agrandir
Le pb, je croix, est que mes CB n'ont pas forcement toute une valeur,
certaine reste blanche. J'ai donc du mettre ds mon code un nbr de If
important
Rien que pour le trie par ex j'ai 11 If qui corresponde a 11 critere de
trie possible

voici une partie de mon Code:

Sheets("Archive").Select
Dim Ligne As Long, C As Range
With Sheets(ShDepart)


'CA TOTAL/1/1
If ComboBox1.Value <> "" And ComboBox2.Value = "" And ComboBox3.Value = "" _
And ComboBox4.Value = "" And ComboBox5.Value = "" _
And ComboBox6.Value = "" And ComboBox7.Value <> "FAUX" And ComboBox8.Value > > > > > "" Then

Ligne = .Range("A65536").End(xlUp).Row + 1
For Each C In Range("AJ4", Range("AJ65536").End(xlUp))
If C = Me.ComboBox7 And C.Offset(, -33) = Me.ComboBox1 Then
.Cells(Ligne, 1) = Cells(C.Row, 1)
.Cells(Ligne, 2) = Cells(C.Row, 2)
.Cells(Ligne, 3) = Cells(C.Row, 3)
.Cells(Ligne, 4) = Cells(C.Row, 4)
.Cells(Ligne, 5) = Cells(C.Row, 5)
.Cells(Ligne, 6) = Cells(C.Row, 6)
.Cells(Ligne, 7) = Cells(C.Row, 7)
.Cells(Ligne, 8) = Cells(C.Row, 8)
.Cells(Ligne, 9) = Cells(C.Row, 9)
.Cells(Ligne, 10) = Cells(C.Row, 10)
.Cells(Ligne, 11) = Cells(C.Row, 11)
.Cells(Ligne, 12) = Cells(C.Row, 12)
.Cells(Ligne, 13) = Cells(C.Row, 13)










1 2