Reduire la longueur de mon code

Signaler
Messages postés
6
Date d'inscription
lundi 23 juillet 2018
Statut
Membre
Dernière intervention
24 juillet 2018
-
Messages postés
2153
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
1 juin 2020
-
bonjour! SVP j'ai tapé un code qui permet de copier le contenu d'une feuille excel nommé BD-TELEINFO vers une autre feuille nommé feuil1 mais lorsque j’exécute on me dire que erreur de compilation: procédure trop grande. je ne sais pas comment réduire mon code

4 réponses

Messages postés
2153
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
1 juin 2020
109
bonjour !
Ceci répondra peut-être à ta question : https://www.commentcamarche.net/forum/affich-13512035-taille-des-procedures-vba-sous-excel
Aussi sans voir le code difficile de répondre de façon sûre !

Messages postés
2153
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
1 juin 2020
109 >
Messages postés
6
Date d'inscription
lundi 23 juillet 2018
Statut
Membre
Dernière intervention
24 juillet 2018

Bonjour !
Tout d'abord pour poster du code voir https://codes-sources.commentcamarche.net/faq/11288-les-balises-de-code

autre chose : je ne suis pas un spécialiste VBA mais je vois que tu répètes X fois ce bout de code :

Sheets("Feuil1").Cells(lig256, 7) = poste.Value
Sheets("Feuil1").Cells(lig256, 8) = Sheets("BD_TELEINFO").Cells(258, 8)
Sheets("Feuil1").Cells(lig256, 9) = Sheets("BD_TELEINFO").Cells(258, 9)
Sheets("Feuil1").Cells(lig256, 10) = Sheets("BD_TELEINFO").Cells(258, 10)
Sheets("Feuil1").Cells(lig256, 11) = Sheets("BD_TELEINFO").Cells(258, 11)
Sheets("Feuil1").Cells(lig256, 12) = Sheets("BD_TELEINFO").Cells(258, 12)
Sheets("Feuil1").Cells(lig256, 18) = Sheets("BD_TELEINFO").Cells(258, 18) 


Je pense qu'il doit être possible d'en faire une procédure à part qui serait appelée par ton code

De plus d'après ce que je vois ton code est tellement long qu'il n'est pas affiché entièrement sue le site

Au lieu de travailler cellule après cellule tu devrais travailler par bloc de cellules avec Range ( voir ce mot dans ton aide VBA ) Ainsi tu pourrais transférer directement des blocs de cellules entiers et non cellule après cellule

Je ne puis t'aider plus désolé !
Messages postés
28954
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
2 juin 2020
329
Bonjour,

Comme le suggère VB95, le découpage en fonctions ou sous "sub" est un bon début
par exemple
Function ajout(ShSource As Worksheet, ShCible As Worksheet, ligSource As Integer, poste)
Dim lig As Integer
lig = Sheets("Feuil1").Range("G10000").End(xlUp).Row 'Enregistrer les participants
lig = lig + 1
ShCible.Cells(lig, 7) = poste.Value
ShCible.Cells(lig, 8) = ShSource.Cells(ligSource, 8)
ShCible.Cells(lig, 9) = ShSource.Cells(ligSource, 9)
ShCible.Cells(lig, 10) = ShSource.Cells(ligSource, 10)
ShCible.Cells(lig, 11) = ShShSourceCible.Cells(ligSource, 11)
ShCible.Cells(lig, 12) = ShShSourceCible.Cells(ligSource, 12)
ShCible.Cells(lig, 18) = ShSource.Cells(ligSource, 18)
ShCible.Cells(lig, 19) = ShSource.Cells(ligSource, 19)

End Function


Et pour l'utiliser (ici j'ai repris tes deux premiers blocs
Sub exemple()
' A placer au début de ta SUB
Dim Sh_source As Worksheet
Dim Sh_cible As Worksheet



'Puis dans ton code, là où tu en as besoin:
Set Sh_cible = Sheets("Feuil1")
Set Sh_source = Sheets("BD_TELEINFO")
a = ajout(Sh_source, Sh_cible, 170, poste)
a = ajout(Sh_source, Sh_cible, 171, poste)



End Sub
Messages postés
8174
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
31 mai 2020
19
Bonjour,

Tu devrais ajouter systématiquement
Option explicit
en début de chaque module !
Ça t'obliges à déclarer toutes les variables que tu utilises.
Dans ton cas, tu te serais rendu compte que tu utilises trop de variables différentes (lig168, lig169, ...) pour un même élément : la première ligne vide d'une colonne. Pour cela, une seule et même variable suffit. Et là, comme tu répètes toujours le même code, il faut créer une boucle.
Voir :
http://silkyroad.developpez.com/vba/boucles/
Il est probable qu'avec un "Sub" et une boucle, ton code ne fasse plus que quelques lignes.
Messages postés
6
Date d'inscription
lundi 23 juillet 2018
Statut
Membre
Dernière intervention
24 juillet 2018

je n'arrive pas a adapter votre solution
Messages postés
2153
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
1 juin 2020
109 >
Messages postés
6
Date d'inscription
lundi 23 juillet 2018
Statut
Membre
Dernière intervention
24 juillet 2018

Bonsoir !
Reprenons au début et allons-y par petit bout

Private Sub Valider5_Click()
    Dim i as integer, comb as Integer 
    If TextBox5.Value <> "" Then
         comb = TextBox5.Value 
         For i = 0 to comb
             ' on verra pour la suite selon ta réponse
         Next
    End If
End Sub


comb correspond à quoi ?
Car il est utilisé dans une boucle For Next ensuite

Autre question : que veux-tu faire dans la boucle exactement ? Si la boucle est nécessaire évidemment !
Explique ligna par ligne le code suivant
lig168 = Sheets("Feuil1").Range("G10000").End(xlUp).Row 'Enregistrer les participants
lig168 = lig168 + 1
Sheets("Feuil1").Cells(lig168, 7) = poste.Value
Sheets("Feuil1").Cells(lig168, 8) = Sheets("BD_TELEINFO").Cells(170, 8)
Sheets("Feuil1").Cells(lig168, 9) = Sheets("BD_TELEINFO").Cells(170, 9)
Sheets("Feuil1").Cells(lig168, 10) = Sheets("BD_TELEINFO").Cells(170, 10)
Sheets("Feuil1").Cells(lig168, 11) = Sheets("BD_TELEINFO").Cells(170, 11)
Sheets("Feuil1").Cells(lig168, 12) = Sheets("BD_TELEINFO").Cells(170, 12)
Sheets("Feuil1").Cells(lig168, 18) = Sheets("BD_TELEINFO").Cells(170, 18)
Sheets("Feuil1").Cells(lig168, 19) = Sheets("BD_TELEINFO").Cells(170, 19) 
Messages postés
6
Date d'inscription
lundi 23 juillet 2018
Statut
Membre
Dernière intervention
24 juillet 2018

bonjour, comb correspond au nombre de fois que je voudrais copier le bloc d'information d'une feuille excel vers une autre
Messages postés
2153
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
1 juin 2020
109
Bonjour !
Ok tu veux donc copier plusieurs fois ces informations
Cherchon tout d'abord à les copier une seule fois
Pourquoi recherches-tu à chaque ligne copiée la dernière ligne vide car si tu copies une ligne la ligne vide est la suivante à mon avis
Dis moi si ce code te copie bien les 2 premières lignes correctement

Dis moi aussi si dans la feuille source toutes les lignes se suivent bien les unes après les autres et le nombre de lignes à copier

Peux-tu nous mettre une image de ta feuille source ( avec le bouton de droite qui représente une montagne )


Option explicit
Private Sheetcible As Worksheet = Sheets("Feuil1") ' feuille destination
Private Shrrtsource As Worksheet  = Sheets("BD_TELEINFO") ' feuille origine

Private Sub Valider5_Click() 
    Dim Ligcible As Integer, Ligsource as integer
    Ligsource = 170 ' première ligne source
    Ligcible = Sheets("Feuil1").Range("G10000").End(xlUp).Row ' première ligne destination
    For i = 0 to 1 ' pour copier 2 lignes
        Ajout(Sheetsource , Sheetcible, Ligcible + i, Ligsource + i, poste)
   End Sub

Private Sub Ajout(Source As Worksheet, Cible As Worksheet, Ligcible as integer, LigSource As Integer, poste)
' Pour copier une ligne de la feuille source vers la feuille cible
    Cible.Cells(Ligcible, 7) = poste.Value
    Cible.Cells(Ligcible, 8) = Source.Cells(ligSource, 8)
    Cible.Cells(Ligcible, 9) = Source.Cells(ligSource, 9)
    Cible.Cells(Ligcible, 10) = Source.Cells(ligSource, 10)
    Cible.Cells(Ligcible, 11) = SourceCible.Cells(ligSource, 11)
    Cible.Cells(Ligcible, 12) = SourceCible.Cells(ligSource, 12)
    Cible.Cells(Ligcible, 18) = Source.Cells(ligSource, 18)
    Cible.Cells(Ligcible, 19) = Source.Cells(ligSource, 19)
End Sub

Messages postés
6
Date d'inscription
lundi 23 juillet 2018
Statut
Membre
Dernière intervention
24 juillet 2018

désolé j'ai essayé mais le code ne passe pas
Messages postés
2153
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
1 juin 2020
109
Informatiquement ta réponse ne veut rien dire !
Y a-t-il un message d'erreur ?
As-tu essayer en pas à pas ?
Si pas à pas sur quelle ligne est l'erreur et quelle est-elle ?

nous ne sommes pas devins ni devant ton Pc
Et tu n'as pas répondu aux autres questions !
On veut bien aider mais faudrait que tu y mettes du tien aussi !
Messages postés
6
Date d'inscription
lundi 23 juillet 2018
Statut
Membre
Dernière intervention
24 juillet 2018

ok compris excusez moi !!!!
1erreur de compilation:
erreur de syntaxe
la ligne " Ajout(Sheetsource , Sheetcible, Ligcible + i, Ligsource + i, poste)" est en rouge
2 erreur de compilation:
instruction incorrecte dans une procédure
la ligne "Private Sheetcible As Worksheet = Sheets("Feuil1") ' feuille destination
Private Shrrtsource As Worksheet = Sheets("BD_TELEINFO") ' feuille origine"
est rouge
3 erreur de compilation:
la declaration de la procedure ne correspond pas a la description de l'evenement ou de la procédure de meme nom
la ligne "Private Sub Ajout(Source As Worksheet, Cible As Worksheet, Ligcible as integer, LigSource As Integer, poste)" est souligné
Messages postés
2153
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
1 juin 2020
109 >
Messages postés
6
Date d'inscription
lundi 23 juillet 2018
Statut
Membre
Dernière intervention
24 juillet 2018

Essaie ceci : je ne suis pas un spécialiste VBA plutôt VB Net

A quoi correspond la variable poste ?

Option explicit
Private Sheetcible As Worksheet
Private Sheetsource As Worksheet

Private Sub Valider5_Click() 
    Dim Ligcible As Integer, Ligsource as integer
    Set Sheetcible = Sheets("Feuil1")  
    Set Sheetsource = Sheets("BD_TELEINFO")
    Ligsource = 170 ' première ligne source
    Ligcible = Sheets("Feuil1").Range("G10000").End(xlUp).Row ' première ligne destination
    For i = 0 to 1 ' pour copier 2 lignes
        Ajout Sheetsource , Sheetcible, Ligcible + i, Ligsource + i, "Poste"
    Next
nd Sub

Private Sub Ajout(Source As Worksheet, Cible As Worksheet, LigneCible as Integer, LigneSource As Integer, poste as String)
' Pour copier une ligne de la feuille source vers la feuille cible
    Cible.Cells(LigneCible, 7) = poste
    Cible.Cells(LigneCible, 8) = Source.Cells(LigneSource, 8)
    Cible.Cells(LigneCible, 9) = Source.Cells(LigneSource, 9)
    Cible.Cells(Lignecible, 10) = Source.Cells(LigneSource, 10)
    Cible.Cells(LigneCible, 11) = Source.Cells(LigneSource, 11)
    Cible.Cells(LigneCible, 12) = Source.Cells(LigneSource, 12)
    Cible.Cells(LigneCible, 18) = Source.Cells(LigneSource, 18)
    Cible.Cells(LigneCible, 19) = Source.Cells(LigneSource, 19)
End Sub
Messages postés
8174
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
31 mai 2020
19
Bonjour,

On tourne en rond !!!

Pour te répondre, il serait plus simple de disposer de ton fichier,
débarrassé des informations confidentielles s'il y lieu.

Déposes le fichier avec des commentaires explicatifs sur
https://mon-partage.fr/
et mets le lien obtenu dans ton prochain message.
--
Cordialement
Patrice
Messages postés
2153
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
1 juin 2020
109
Bonjour Patrice
C'est vrai que cela est une option à laquelle je n'avais pas pensé
Ceci nous permettrait de voir la structure réelle de sa feuille Excel et de voir ce qu'elle veut vraiment faire !

Pour Carole
Essaie ceci : je ne suis pas un spécialiste VBA plutôt VB Net
Ce code fonctionne : je l'ai essayé sur Microsoft Office 2016
Il transfère les 2 premières lignes de BD_TELEINFO vers Feuil1

A quoi correspond la variable poste ?

Option explicit
Private Sheetcible As Worksheet
Private Sheetsource As Worksheet

Private Sub Valider5_Click() 
    Dim Ligcible As Integer, Ligsource as integer, i as Integer
    Set Sheetcible = Sheets("Feuil1")  
    Set Sheetsource = Sheets("BD_TELEINFO")
    Ligsource = 170 ' première ligne source
    Ligcible = 168 ' première ligne destination
    For i = 0 to 1 ' pour copier 2 lignes
        Ajout Sheetsource , Sheetcible, Ligcible + i, Ligsource + i, "Poste"
    Next
nd Sub

Private Sub Ajout(Source As Worksheet, Cible As Worksheet, LigneCible as Integer, LigneSource As Integer, poste as String)
' Pour copier une ligne de la feuille source vers la feuille cible
    Cible.Cells(LigneCible, 7) = poste
    Cible.Cells(LigneCible, 8) = Source.Cells(LigneSource, 8)
    Cible.Cells(LigneCible, 9) = Source.Cells(LigneSource, 9)
    Cible.Cells(Lignecible, 10) = Source.Cells(LigneSource, 10)
    Cible.Cells(LigneCible, 11) = Source.Cells(LigneSource, 11)
    Cible.Cells(LigneCible, 12) = Source.Cells(LigneSource, 12)
    Cible.Cells(LigneCible, 18) = Source.Cells(LigneSource, 18)
    Cible.Cells(LigneCible, 19) = Source.Cells(LigneSource, 19)
End Sub
Messages postés
2153
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
1 juin 2020
109 >
Messages postés
2153
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
1 juin 2020

Encore mieux
Private Sheetcible As Worksheet
Private Sheetsource As Worksheet

Private Sub Valider_Click()
    Dim Ligcible As Integer, Ligsource As Integer, i As Integer
    Set Sheetcible = Sheets("Feuil1")
    Set Sheetsource = Sheets("BD_TELEINFO")
    Ligsource = 170 ' première ligne source
    Ligcible = 168 ' première ligne destination
    For i = 0 To 1 ' pour copier 2 lignes
        Ajout Sheetsource, Sheetcible, Ligcible + i, Ligsource + i, "Poste"
    Next
End Sub

Private Sub Ajout(Source As Worksheet, Cible As Worksheet, LigneCible As Integer, LigneSource As Integer, poste As String)
' Pour copier une ligne de la feuille source vers la feuille cible
    Dim j As Integer
    Cible.Cells(LigneCible, 7) = poste ' copie colonne 7
    For j = 8 To 12
    ' copie colonnes 8 à 12
        Cible.Cells(LigneCible, j) = Source.Cells(LigneSource, j)
    Next
    ' copie les colonnes 18 et 19
    Cible.Cells(LigneCible, 18) = Source.Cells(LigneSource, 18)
    Cible.Cells(LigneCible, 19) = Source.Cells(LigneSource, 19)
End Sub