FONCTION VBA beaucoup trop grande....

A

alain.raphael

XLDnaute Occasionnel
Bonjour à Tous,

J'ai une Fonction SUB > à 64 Ko, et je ne sais pas comment la réduire.

J'ai des champs dans un formulaire (Date, numéro....) et des CheckBox concernant 24 personnes.

Si je sélectionne les CheckBox 1 et 3, les données des champs se remplissent après validation du formulaire dans les pages des personnes 1 et 3, mais aussi le nom des autres personnes des checkBox cochées :

Exemple : CheckBox 1, 3, 4 cochées : sur la page 1 le nom des personnes 3 et 4 s'affichent (ainsi que les données)
sur la page 3 le nom des personnes 1 et 4 s'affichent
sur la page 4 le nom des personnes 1 et 3 s'affichent.

Ci-joint le code :
Code: 
Private Sub VALIDERINDIVIDU_Click()
'declaration des variables
Dim DatePlongee As String * 10
Dim LieuPlongee As String * 60
Dim CommunePlonge As String * 30
Dim EICSTPlongee As String
Dim ButPlongee As String * 100
Dim HeureDebutimmersionPlongee As String
Dim HeureFinimmersionPlongee As String
Dim DureePLongee As String * 3
Dim ProfondeurPlongee As String * 2
Dim CourantPlongee As String
Dim Ecriture As Boolean
Dim VisibilitePlongee As String
Dim TemperaturePlongee As String
Dim NomDPPlongee As String
Dim NumLigne, NbPlongees As Integer
Dim Cellule As String

'Affectations des variables

DatePlongee = Da.Text
LieuPlongee = Lieu.Text
CommunePlongee = Com.Text
EICSTPlongee = ComboBoxEICST.Value
ButPlongee = But.Text
HeureDebutimmersionPlongee = Hd.Value
HeureFinimmersionPlongee = Hf.Value
DureePLongee = Duree.Text
ProfondeurPlongee = Pro.Text
CourantPlongee = ComboBoxCou.Value
VisibilitePlongee = ComboBoxVisi.Value
TemperaturePlongee = T.Text
NomDPPlongee = ComboBoxDP.Value


Range("A7").Select


'Avertissement que les champs soient remplis
If DatePlongee = "" Or LieuPlongee = "" Or CommunePlongee = "" Or EICSTPlongee = "" Or ButPlongee = "" Or HeureDebutimmersionPlongee = "" Or HeureFinimmersionPlongee = "" Or DureePLongee = "" Or ProfondeurPlongee = "" Or CourantPlongee = "" Or VisibilitePlongee = "" Or TemperaturePlongee = "" Or NomDPPlongee = "" Then
Reponse = MsgBox("Vous avez oublié de remplir certains champs !!", 0, "Informations manquantes")

Else


'insertion des valeurs sur les feuilles individuelles

If CheckBox1.Value Then

NumLigne = Feuil4.Range("a65536").End(xlUp).Row + 1
Feuil4.Cells(NumLigne, 1) = NumLigne - 6
Feuil4.Cells(NumLigne, 2) = CDate(Da.Value)
Feuil4.Cells(NumLigne, 3) = Lieu.Value
Feuil4.Cells(NumLigne, 4) = Com.Value
Feuil4.Cells(NumLigne, 5) = ComboBoxEICST.Value
Feuil4.Cells(NumLigne, 6) = But.Value
Feuil4.Cells(NumLigne, 7) = Hd.Value
Feuil4.Cells(NumLigne, 8) = Hf.Value
Feuil4.Cells(NumLigne, 9) = Duree.Value
Feuil4.Cells(NumLigne, 10) = Pro.Value
Feuil4.Cells(NumLigne, 11) = ComboBoxCou.Value
Feuil4.Cells(NumLigne, 12) = ComboBoxVisi.Value
Feuil4.Cells(NumLigne, 13) = T.Value
Feuil4.Cells(NumLigne, 14) = ComboBoxDP.Value
  If CheckBox2.Value Then
 Feuil4.Cells(NumLigne, 17) = "2"
 Else
 Feuil4.Cells(NumLigne, 17) = ""
 End If
  If CheckBox3.Value Then
 Feuil4.Cells(NumLigne, 18) = "3"
 Else
 Feuil4.Cells(NumLigne, 18) = ""
 End If
  If CheckBox4.Value Then
 Feuil4.Cells(NumLigne, 19) = "4"
 Else
 Feuil4.Cells(NumLigne, 19) = ""
 End If
  If CheckBox5.Value Then
 Feuil4.Cells(NumLigne, 20) = "5"
 Else
 Feuil4.Cells(NumLigne, 20) = ""
 End If
  If CheckBox6.Value Then
 Feuil4.Cells(NumLigne, 21) = "6"
 Else
 Feuil4.Cells(NumLigne, 21) = ""
 End If
  If CheckBox7.Value Then
 Feuil4.Cells(NumLigne, 22) = "7"
 Else
 Feuil4.Cells(NumLigne, 22) = ""
 End If
  If CheckBox8.Value Then
 Feuil4.Cells(NumLigne, 23) = "8"
 Else
 Feuil4.Cells(NumLigne, 23) = ""
 End If
  If CheckBox9.Value Then
 Feuil4.Cells(NumLigne, 24) = "9"
 Else
 Feuil4.Cells(NumLigne, 24) = ""
 End If
  If CheckBox10.Value Then
 Feuil4.Cells(NumLigne, 25) = "10"
 Else
 Feuil4.Cells(NumLigne, 25) = ""
 End If
  If CheckBox11.Value Then
 Feuil4.Cells(NumLigne, 26) = "11"
 Else
 Feuil4.Cells(NumLigne, 26) = ""
 End If
  If CheckBox12.Value Then
 Feuil4.Cells(NumLigne, 27) = "12"
 Else
 Feuil4.Cells(NumLigne, 27) = ""
 End If
  If CheckBox13.Value Then
 Feuil4.Cells(NumLigne, 28) = "13"
 Else
 Feuil4.Cells(NumLigne, 28) = ""
 End If
  If CheckBox14.Value Then
 Feuil4.Cells(NumLigne, 29) = "14"
 Else
 Feuil4.Cells(NumLigne, 29) = ""
 End If
  If CheckBox15.Value Then
 Feuil4.Cells(NumLigne, 30) = "15"
 Else
 Feuil4.Cells(NumLigne, 30) = ""
 End If
  If CheckBox16.Value Then
 Feuil4.Cells(NumLigne, 31) = "16"
 Else
 Feuil4.Cells(NumLigne, 31) = ""
 End If
  If CheckBox17.Value Then
 Feuil4.Cells(NumLigne, 33) = "17"
 Else
 Feuil4.Cells(NumLigne, 33) = ""
 End If
  If CheckBox18.Value Then
 Feuil4.Cells(NumLigne, 34) = "18"
 Else
 Feuil4.Cells(NumLigne, 34) = ""
 End If
  If CheckBox19.Value Then
 Feuil4.Cells(NumLigne, 35) = "19"
 Else
 Feuil4.Cells(NumLigne, 35) = ""
 End If
 If CheckBox20.Value Then
 Feuil4.Cells(NumLigne, 36) = "20"
 Else
 Feuil4.Cells(NumLigne, 36) = ""
 End If
  If CheckBox21.Value Then
 Feuil4.Cells(NumLigne, 37) = "21"
 Else
 Feuil4.Cells(NumLigne, 37) = ""
 End If
  If CheckBox22.Value Then
 Feuil4.Cells(NumLigne, 38) = "22"
 Else
 Feuil4.Cells(NumLigne, 38) = ""
 End If
  If CheckBox23.Value Then
 Feuil4.Cells(NumLigne, 39) = "23"
 Else
 Feuil4.Cells(NumLigne, 39) = ""
 End If
  If CheckBox24.Value Then
 Feuil4.Cells(NumLigne, 40) = "24"
 Else
 Feuil4.Cells(NumLigne, 40) = ""
 End If

End If

  'insertion des valeurs sur les feuilles individuelles

If CheckBox2.Value Then

NumLigne = Feuil5.Range("a65536").End(xlUp).Row + 1
Feuil5.Cells(NumLigne, 1) = NumLigne - 6
Feuil5.Cells(NumLigne, 2) = CDate(Da.Value)
Feuil5.Cells(NumLigne, 3) = Lieu.Value
Feuil5.Cells(NumLigne, 4) = Com.Value
Feuil5.Cells(NumLigne, 5) = ComboBoxEICST.Value
Feuil5.Cells(NumLigne, 6) = But.Value
Feuil5.Cells(NumLigne, 7) = Hd.Value
Feuil5.Cells(NumLigne, 8) = Hf.Value
Feuil5.Cells(NumLigne, 9) = Duree.Value
Feuil5.Cells(NumLigne, 10) = Pro.Value
Feuil5.Cells(NumLigne, 11) = ComboBoxCou.Value
Feuil5.Cells(NumLigne, 12) = ComboBoxVisi.Value
Feuil5.Cells(NumLigne, 13) = T.Value
Feuil5.Cells(NumLigne, 14) = ComboBoxDP.Value
  If CheckBox1.Value Then
 Feuil5.Cells(NumLigne, 16) = "1"
 Else
 Feuil5.Cells(NumLigne, 16) = ""
 End If
  If CheckBox3.Value Then
 Feuil5.Cells(NumLigne, 18) = "3"
 Else
 Feuil5.Cells(NumLigne, 18) = ""
 End If

                                                                 Etc…….

End If

                                                  ETC…POUR LES 22 autres CHECKBOX…….

'fin
If MsgBox("Une fois affectée, Pensez à VALIDER la Plongée", vbOKOnly, "2ème bouton") = vbOK Then

Range("A1").Select

End If
End If
End Sub
 
Trier par date Trier par votes
Paf

Paf

XLDnaute Barbatruc
Re : FONCTION VBA beaucoup trop grande....

Re

Après avoir renommé les checkbox de 1 à 24 et mis le nom initial dans la caption de la checkbox:

Code: 
Private Sub VALIDERINDIVIDU_Click()

'declaration des variables
Dim DatePlongee As String * 10
Dim LieuPlongee As String * 60
Dim CommunePlonge As String * 30
Dim EICSTPlongee As String
Dim ButPlongee As String * 100
Dim HeureDebutimmersionPlongee As String
Dim HeureFinimmersionPlongee As String
Dim DureePLongee As String * 3
Dim ProfondeurPlongee As String * 2
Dim CourantPlongee As String
Dim Ecriture As Boolean
Dim VisibilitePlongee As String
Dim TemperaturePlongee As String
Dim NomDPPlongee As String
Dim NumLigne, NbPlongees As Integer
Dim Cellule As String

'Affectations des variables

DatePlongee = Da.Text
LieuPlongee = Lieu.Text
CommunePlongee = Com.Text
EICSTPlongee = ComboBoxEICST.Value
ButPlongee = But.Text
HeureDebutimmersionPlongee = Hd.Value
HeureFinimmersionPlongee = Hf.Value
DureePLongee = Duree.Text
ProfondeurPlongee = Pro.Text
CourantPlongee = ComboBoxCou.Value
VisibilitePlongee = ComboBoxVisi.Value
TemperaturePlongee = T.Text
NomDPPlongee = ComboBoxDP.Value


Range("A7").Select


'Avertissement que les champs soient remplis
If DatePlongee = "" Or LieuPlongee = "" Or CommunePlongee = "" Or EICSTPlongee = "" Or ButPlongee = "" Or HeureDebutimmersionPlongee = "" Or HeureFinimmersionPlongee = "" Or DureePLongee = "" Or ProfondeurPlongee = "" Or CourantPlongee = "" Or VisibilitePlongee = "" Or TemperaturePlongee = "" Or NomDPPlongee = "" Then
Reponse = MsgBox("Vous avez oublié de remplir certains champs !!", 0, "Informations manquantes")

Else


'insertion des valeurs sur les feuilles individuelles


'***** début modif
For i = 1 To 24 'pour chaque personne
    If Controls("CheckBox" & i) = True Then
        With Worksheets("" & i) ' les feuilles(.Name) s'appellent 1,2,3 .....
            NumLigne = .Range("a65536").End(xlUp).Row + 1
            .Cells(NumLigne, 1) = NumLigne - 6
            .Cells(NumLigne, 2) = CDate(Da.Value)
            .Cells(NumLigne, 3) = Lieu.Value
            .Cells(NumLigne, 4) = Com.Value
            .Cells(NumLigne, 5) = ComboBoxEICST.Value
            .Cells(NumLigne, 6) = But.Value
            .Cells(NumLigne, 7) = Hd.Value
            .Cells(NumLigne, 8) = Hf.Value
            .Cells(NumLigne, 9) = Duree.Value
            .Cells(NumLigne, 10) = Pro.Value
            .Cells(NumLigne, 11) = ComboBoxCou.Value
            .Cells(NumLigne, 12) = ComboBoxVisi.Value
            .Cells(NumLigne, 13) = T.Value
            .Cells(NumLigne, 14) = ComboBoxDP.Value
    
        For j = 1 To 16
            If j <> i And Controls("CheckBox" & j) = True Then
                .Cells(NumLigne, 15 + j) = Controls("CheckBox" & j).Caption
            End If
        Next
        For j = 17 To 24
            If j <> i And Controls("CheckBox" & j) = True Then
            .Cells(NumLigne, 16 + j) = Controls("CheckBox" & j).Caption
            End If
        Next
    End With
    End If
Next
'***** fin modif

End If
End Sub

NB a priori dans chaque feuille il manque une colonne dans la partie Autres CU-CT Présents :7 colonnes pour 8 noms possibles

Bon courage et bonne suite


PS il y aurait quelques optimisations à prévoir notamment sur le chargement des combobox
 
Dernière édition:
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : FONCTION VBA beaucoup trop grande....

Bonsoir àtous

Paf:
Que penses-tu de cette modif ?
(non testée)
Code: 
For j = 1 To 24
If j <> i And Controls("CheckBox" & j) = True Then
Select case j
Case 1 to 16
.Cells(NumLigne, 15 + j) = Controls("CheckBox" & j).Caption
Case 17 to 24
.Cells(NumLigne, 16 + j) = Controls("CheckBox" & j).Caption
End Select
End If
Next

EDITION: Houps pas rafraichi, pas vu ton dernier message
 
Dernière édition:
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
Re : FONCTION VBA beaucoup trop grande....

Re Staple1600

cela crée des tests supplémentaires mais vu le faible nombre d'itérations il ne doit pas y avoir de différences de temps d'éxécution.

J'aurais bien essayé ce qu'avais proposé Efgé au post #8:
TData(1, i + 15 + (i > 15)) = i

mais j'avoue ne pas saisir complètement

A+
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
Re : FONCTION VBA beaucoup trop grande....

Re re
Maintenant que c'est plus lisible j'aurais plutôt fait:

Code: 
For j = 1 To 24
  If j <> i And Controls("CheckBox" & j) = True Then
     Select case j
    Case 1 to 16
.       Cells(NumLigne, 15 + j) = Controls("CheckBox" & j).Caption
    Case 17 to 24
.       Cells(NumLigne, 16 + j) = Controls("CheckBox" & j).Caption
    End Select
  End If
Next

A+
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
Re : FONCTION VBA beaucoup trop grande....

@ Staple1600

réponse au post #33,

Je ne crois pas qu'une seule boucle suffise:

la boucle extérieure écrit, pour chaque participant, dans sa feuille les données communes saisie dans l'USF et la deuxième va chercher tous les "participants" cochés pour les inscrire dans cette feuille.

A+
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
Re : FONCTION VBA beaucoup trop grande....

Re Staple1600

(on va finir par se comprendre )

C'est bien ce que j'avais cru comprendre et ma réponse (post #34) était adaptée.

en terme de temps pas sûr que ce soit plus lent (une seule boucle mais un test sur chaque itération) parce qu'il y a peu d'itération.
en terme de lisibilité c'est surement plus clair.
en terme de puriste je ne sais (suis) pas.

A+
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
Re : FONCTION VBA beaucoup trop grande....

Re

l'écriture alternative de Efgé résout le dilemme des deux boucles ou une seule avec select,

Même si je n'ai pas encore compris pourquoi, ça marche après avoir procédé empiriquement:
Code: 
 For j = 1 To 24
            If j <> i And Controls("CheckBox" & j) = True Then
                .Cells(NumLigne, 15 + j + (j < 17)) = Controls("CheckBox" & j).Caption
            End If
        Next

Mais, il y a un soucis dans la structure des feuilles de chaque plongeur.

On a deux groupes de plongeurs un de 16 nommé SAL et un de 8 nommé CU... et, on a pour chaque feuille 16 colonnes pour SAL et 7 pour CU.
Or si on traite la feuille d'un SAL il suffit de 15 colonnes pour SAL mais 8 pour CU
et si on traite un CU, il faut bien 16 colonnes SAL mais 7 pour CU

Je réfléchirai à une solution , ... demain

Bonne nuit à tous
 
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : FONCTION VBA beaucoup trop grande....

Bonjour à tous :)
Je vois que mon "+ (j > 16)" parait ésotérique :D
Je l'explique
Repartons d'une syntaxe plus simple
VB: 
    Case 1 to 16
.       Cells(NumLigne, 15 + j) = Controls("CheckBox" & j).Caption
    Case 17 to 24
.       Cells(NumLigne, 16 + j) = Controls("CheckBox" & j).Caption

Si le contrôle (J) est inférieur ou égal à 16 on fait Cells(NumLigne, 15 + j) , si supérieur à 16 Cells(NumLigne, 16 + j)
16 C'est 15 + 1
Mon (j > 16) renvoi faux (0) si J est inférieur ou égal à 16 et Vrai (1) si J est > 16.
Donc avec
Cells(NumLigne, (15 + (j > 16)) + j) = Controls("CheckBox" & j).Caption
On a donc alternativement 15 + 0 ou 15 + 1

En espérant avoir été plus clair

Cordialement
 
Vote positif 0 Vote négatif
A

alain.raphael

XLDnaute Occasionnel
Re : FONCTION VBA beaucoup trop grande....

Oui merci à Tous et aussi bien-sûr à Staple 1600 et Efgé......

Je suis parti sur la solution de PAF du post #32. Tout marche impeccable sauf en effet la dernière personne (dernière checkbox). (Je n'ose pas encore faire celle du post #43).

C'est une erreur de ma part de n'avoir mis que 7 colonnes pour les CU, car pour simplification je voulais 16 colonnes SAL + 8 pour les CU, même s'il y a, du coup, toujours une colonne vide : celle de la personne du feuillet.

Je peux même par simplification encore, enlever la colonne de mise en page vide entre les SAL et les CU.

De ce fait si je rajoute la 8ème colonne CU, je ne vois pas ce que je dois changer dans ma formule ??

PS : j'aurais pensé qu'avec la dernière checkbox sélectionnée (la fameuse 8ème CU), le nom s'afficherai à côté du tableau : dans une colonne non mise en page...et ce n'est pas le cas...:confused:
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

E
  • Résolu(e)
Microsoft 365 Boucle sur lignes <>0
Réponses
2
Affichages
156
eric72
E
D
  • Question
XL 2010 Valoriser cellule par clic
Réponses
4
Affichages
233
fanch55
fanch55
D
  • Question
XL 2010 Identification d'une cellule cliquée
Réponses
6
Affichages
353
dadu35
D
yojema
  • Question
XL 2021 faire évoluer un code VBA
Réponses
3
Affichages
170
Dranreb
Dranreb
S
  • Question
XL 2021 macro VBA excel
Réponses
1
Affichages
177
crocrocro
C
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
84
Latias
L
M
  • Question
Microsoft 365 Modifier code et format textbox
2 3
Réponses
35
Affichages
740
Marvin57
M
S
  • Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
157
souhaib ad
S
petitbuzuc
  • Question
XL 2016 Aide pour maj auto de la date + selection multiple dans une liste déroulante
Réponses
5
Affichages
240
fanch55
fanch55
A
  • Question
Microsoft 365 Code VBA Envoi contenu tableau Excel par Email
Réponses
1
Affichages
124
Phil69970
Phil69970

Membres actuellement en ligne

18 membres et 122 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 332
Messages
2 087 362
Membres
103 530
dernier inscrit
Chess01