Erreur de compilation : Procédure trop grande

Bonjour,

Je viens vous demander un peu d'aide, les sujets du même type n'ont pas résolu mon soucis ;(

J'ai créé un code qui me permet de remplir des cellules par sélection, en effet dans ma plage "A20:AK34" j'ai ma base de données,

en cliquant sur une donnée je veux pour commencer que la case A1 se remplisse avec cette donnée puis B1 puis soit A2 et B2 soit D1 et E1 si j'ai auparavant fusionné A1:A3 et B1:B3 ainsi de suite sur la plage entière A1:AI15.

J'utilise donc ce type de code que je répète en changeant les valeurs de cellules mais malheureusement le code entier est beaucoup trop grand (environ 2000 lignes) ici pour ex. la partie concernant une zone de mon tableau à remplir "A9:B10" :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("A20:AK34")) Is Nothing Then Exit Sub
    If [A9].Value = 0 And ["AH5:AI7"] <> 0 Or [AH7].MergeCells <> 0 And [A9].Value = 0 Then
    [A9].Value = Target.Offset(0, 0).Value
    Else

    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("A20:AK34")) Is Nothing Then Exit Sub
    If [A9].Value <> 0 And [B9].Value = 0 Then
    [B9].Value = Target.Offset(0, 0).Value
    Else

    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("A20:AK34")) Is Nothing Then Exit Sub
    If ["A9:B9"] <> 0 And [A10].Value = 0 And [A11].MergeCells = 0 Then
    [A10].Value = Target.Offset(0, 0).Value
    Else

    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("A20:AK34")) Is Nothing Then Exit Sub
    If ["A9:B9"] <> 0 And [A10].Value <> 0 And [B10].Value = 0 And [A11].MergeCells = 0 Then
    [B10].Value = Target.Offset(0, 0).Value
    Else

    End If
    End If
    End If
    End If

    End Sub
6classeur1.xlsm (96.59 Ko)

En espérant que vous pourrez m'aider à compacter ce code, le diviser en plusieurs procédures ou autre.

D'avance merci

Bonjour

Augmente tes chances d'intéresser quelqu'un en joignant un fichier Excel

Lis d'abord ceci

https://forum.excel-pratique.com/annonces/explications-et-regles-a-respecter-t13.html

Cordialement

Bonjour,

J'ai lu cette charte mais mon fichier dépasse largement les 1Mo.

Je viens d'éditer en ajoutant un fichier qui ne contient que le tableau et mon code, pas tout à fait mon fichier de base mais qui s'en rapproche assez pour mieux comprendre mon problème.

Merci de cette remarque l'ajout de ce fichier devrait aider.

Bonjour

Pourquoi répéter cette instruction?

If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("A20:AK34")) Is Nothing Then Exit Sub

En tête de procédure, une fois suffit.

De plus

Target.Offset(0, 0).Value

revient à Target.Value

La longueur de'une procédure est semble-t-il limitée à 64K

A+

Cordialement

Bonjour,

Pour résumer un peu je t'ai fait le début...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim v
If Target.Count > 1 Then Exit Sub
v = Target.Value
If Application.Intersect(Target, Range("A20:AK34")) Is Nothing Then Exit Sub
    If [A1] = 0 Then
    [A1] = v
    '[H1].Interior.ColorIndex = 5
    ElseIf [A1] <> 0 And [B1] = 0 Then
    [B1] = v
    'Quelle que soit la plage considérée ce genre de condition est TOUJOURS VRAI :
    '["A1:B1"] <> 0 And
    'Tu peux donc les supprimer partout !
    ElseIf [A2] = 0 And Not [A3].MergeCells Then
    [A2] = v
    ElseIf [A2] <> 0 And [B2] = 0 And Not [A3].MergeCells Then
    [B2] = v
    ElseIf [A3] = 0 And Not [A3].MergeCells Then
    [A3] = v
    ElseIf [A3] <> 0 And [B3] = 0 And Not [A3].MergeCells Then
    [B3] = v
    ElseIf [A3].MergeCells And [D1] = 0 Or ["A1:B3"] <> 0 And [D1] = 0 Then
    [D1] = v
    ElseIf [D1] <> 0 And [E1] = 0 Then
    [E1] = v
    ElseIf [D2] = 0 And Not [D3].MergeCells Then
    [D2] = v
'... La suite à l'identique en remplaçant tous les MergeCells = 0 par Not [..].MergeCells
'...et tous les MergeCells <> 0 comme j'ai fait pour [A3]
'avec à la fin un seul End If
'YAPUKA corriger la suite sur le même modèle...

End if

A+

Merci je vais essayer ta proposition qui me paraît bien plus optimisée en espérant ne pas dépasser ces fameux 64K de poids.

Merci à vous Amadéus et galopin01 désormais le code est bien plus petit et je n'ai donc plus d'erreurs.

Avant de passer le sujet en résolu j'aimerais savoir si il y aurait une autre solution?

Pour d'éventuels soucis du même type à l'avenir comme diviser la procédure en plusieurs:

"Sub Worksheet_SelectionChange" par exemple SelectionChange_1 puis _2 etc ?

Car fermer la procédure et réouvrir avec le même nom ne marche pas.

Ou autre astuce: Le code de Feuil1 ne ferait qu'appeler des bouts de procédure que j'aurais mis dans des modules?

Dans tous les cas simplifier le code comme vous me l'avez proposé reste la meilleure solution pour le soucis que j'avais.

Bonsoir,

Il est très vraisemblable que ma proposition ne conviennent pas !

En effet j'ai mal interprétés tes imbrications de If... Else

Quand à ta manière de tester les MergeCells elle entraîne une telle confusion que je ne suis même plus certain du résultat !

MergeCells renvoie Vrai ou Faux tester ça avec des =0 ou <> de 0 est assez confus dans mon esprit...

La seule chose qui me semble à peu près certain maintenant , c'est que tu doivent surement revoir ta stratégie de calcul :

Utiliser Worksheet_SelectionChange me semble très peu approprié à ce que tu veux faire...

A+

Mon code était fonctionnel et il le reste avec vos propositions ne t'en fait pas ça convient tout à fait càd:

  • Déclarer une constante v = Target.Value
  • Ne pas répéter les instructions (Target.Count > 1 et Application.Intersect(Target, Range("A20:AK34")) ) à chaque lignes
  • Et remplacer les Else par des ElseIf qui permet de supprimer mes 288 End If

Pour ce qui est de la stratégie de calcul, Worksheet_SelectionChange me permet d'incrémenter les cases par simple clic (et donc selection de cellule) c'est ce que je recherche peut être existe-il mieux en tout cas cette procédure fonctionne parfaitement.

Mon soucis était plus qu'en cas de code non optimisé comme au départ il devient vite très long et lourd en octet.

(Problème d'ailleurs résolu grâce à vos optimisations)

Je me demande toujours par curiosité seulement, si un autre moyen n'est pas envisageable, l'outil de deboguage me proposait de diviser le code en plusieurs parties d'où ma question de déclarer plusieurs procédures ou de diviser le code dans des modules.

Je ne sais pas vraiment comment faire cela car plusieurs Sub Worksheet_SelectionChange ne fonctionne pas (ce qui semble logique) problème de nom identique et un call de sub dans des modules ok mais j'ai besoin de nommer la macro Sub Worksheet_SelectionChange chose impossible pour la même raison: noms identique.

Je suis débutant donc je demandais comment utiliser cette procédure: Sub Worksheet_SelectionChange dans des modules ou autre tout en nommant la macro du module autrement par ex.

Pas forcément besoin de se prendre la tête à chercher, c'est plus de la curiosité pour d'éventuels futures macros, je vais donc passer en résolu.

Merci pour votre aide

C'est quand même très capillo-tracté ton histoire !

Mais sans le fichier difficile de te suggérer quoi que soit !

A+

Rechercher des sujets similaires à "erreur compilation procedure trop grande"