Auto fill dynamique

Version imprimable

Auto fill dynamique

Bonjour à tous,

Voilà, je ne suis pas très forte en vba (complètement nulle même), mais j'aurai besoin de passer par Autofill.
Voilà le truc.
Je dois créer, imprimer et supprimer un graphique automatiquement (ça c'est bon). Dans ce graphique, il y a une ligne pour chaque catégorie (C), une colonne pour chaque semaine (S) et deux moyennes (A et B).

Semaines 1 2 3 4
Cat1 x x
Cat2 x x
...
MoyA x x x x
MoyB x x x x

Si j'étire à l'avance les formules des moyennes, la courbe du graphique retombe vers le zéro. Aussi il me faudrait quelque chose du type:

"Si au moins une cellule est non nulle dans la zone "D2: D28" alors étirer la formule écrite en "B29" de "B29" à "D29"." Sachant que les colonnes doivent être dynamiques.

Pour le moment mon code ressemble à ça:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Sub ESSAI() With Worksheets("SYN") Dim cc As Integer 'pour colonne Dim ll As Integer 'pour ligne For cc = 2 To 5 For ll = 2 To 5 If Not IsEmpty(Cells(ll, cc)) Then Range("B29").FormulaLocal = "=MOYENNE(B4;B5;B11;B12;B14;B15;B16;B17;B19;B20;B22;B26;B28)" Range("B29").AutoFill Destination:=Range(Cells(29, 2), Cells(29, cc).FillRight) MsgBox "Etiré jusqu'à la colonne " & cc End If Next ll Next cc End With End Sub
Et je ne comprend pas pour quoi ça ne fonctionne pas... :?

15/01/2013, 11h35
Daniel.C

J'ai un peu de mal à comprendre la disposition de tes données. Peux-tu mettre un classeur exemple - sans données confidentielles - en pièce jointe ?
15/01/2013, 14h19
MaelB

1 pièce(s) jointe(s)

Voilà, j'ai retiré beaucoup de chose mais normalement, il reste de quoi comprendre pour toi.
J'espère que tu réussira à lire le fichier, c'est la première fois que j'utilise cette fonction... 8O

N'oublie pas de mettre PDF Creator en imprimante par défaut sinon la macro lancera l'impression papier.

Essaie comme ça :

Code:

1
2
3
4
5
6
7
8
Sub ESSAI()
    Dim Col As Integer
    With Worksheets("SYN")
        Col = .Range("2:27").Find("*", , , , xlByColumns, xlPrevious).Column
        Range("B29").FormulaLocal = "=MOYENNE(B4;B5;B11;B12;B14;B15;B16;B17;B19;B20;B22;B26;B28)"
        Range("B29").AutoFill Destination:=Range(Cells(29, 2), Cells(29, Col))
    End With
End Sub

15/01/2013, 16h14
MaelB

Hum, ça bug... 8O A chaque fois ça veut envoyer un rapport d'erreur et ça plante Excel...

Que le fantôme qui hante mon ordi sorte tout de suite, il est vieux mais il a pas encore rendu l'âme!! :mouarf:
15/01/2013, 17h47
Daniel.C

Quelle est ta version d'Excel ? Je n'ai pas trouvé dans le classeur la macro "ESSAI" que tu as publié ? J'ai collé la mienne dans "Module1" et je l'exécute sans problème. As-tu essayé de l'exécuter ligne à ligne (avec la touche F8) pour voir quelle ligne provoque le plantage ?

Bonjour,

Après divers essais c'est un peu plus clair. En fait, la macro fonctionne nickel tant quelle est dans le "Module 1". Dès lors que je la met sur la feuille,ça plante. Il faudrait que ça se fasse à chaque changement pour que je sois sûre d'être à jour.
Code:

1 2 3 4 5 6 7 8 9 10 Private Sub Worksheet_Change(ByVal Target As Range) Dim Col As Integer With Worksheets("SYN") Col = .Range("2:27").Find("*", , , , xlByColumns, xlPrevious).Column Range("B28").FormulaLocal = "=MOYENNE(B4;B5;B10;B11;B13;B14;B15;B16;B18;B19;B21;B25;B27)" Range("B28").AutoFill Destination:=Range(Cells(28, 2), Cells(28, Col)) End With End Sub
J'ai fais des test avec le point d'arrêt. J'en ai mis partout puis je les ai enlevé au fur et à mesure. Je crois que c'est la ligne en gras qui bug, je l'ai pourtant relu plusieurs fois et j'ai corrigé quelques erreurs mais rien à faire, ça marche pas.

Sinon, le code doit être compatible 2003 et 2010, le transfert n'est pas encore terminé...

Pourquoi est-ce qu'il n'existe pas un genre d'encyclopédie du VBA? (Si ça existe, merci de me dire où je pourrai me la procurer ;) )

Bonjour,

Essaie :
Code:

1 2 3 4 5 6 7 8 9 10 Private Sub Worksheet_Change(ByVal Target As Range) Dim Col As Integer With Worksheets("SYN") Col = .Range("2:27").Find("*", , , , xlByColumns, xlPrevious).Column .Range("B28").FormulaLocal = "=MOYENNE(B4;B5;B10;B11;B13;B14;B15;B16;B18;B19;B21;B25;B27)" .Range("B28").AutoFill Destination:=.Range(.Cells(28, 2), .Cells(28, Col)) End With End Sub
Quant à une bible, tu as celui-ci, en anglais (malheureusement) et il n'est pas donné. Tu peux toujours voir avec ta boîte...

(Excel 2007 Power Programming with VBA [With CDROM]) BY (Walkenbach, John)

Regarde aussi ici :

http://excel.developpez.com/livres/

Essaies ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub Worksheet_Change(ByVal Target As Range)
 
If Target.Count = 1 Then
    If Target.Value <> "" Then
        Application.EnableEvents = False
        Remplir 28, Range("B4,B5,B10,B11,B13,B14,B15,B16,B18,B19,B21,B25,B27"), Target
        Remplir 29, Range("B4,B5,B11,B12,B14,B15,B16,B17,B19,B20,B22,B26,B28"), Target
        Application.EnableEvents = True
    End If
End If
End Sub
 
'LigDest: ligne 28 ou 29
'Plage: Plage à moyenner
'CelModif: Cellule modifiée
Private Sub Remplir(ByVal LigDest As Integer, ByVal Plage As Range, ByVal CelModif As Range)
 
If Not Intersect(Plage, Range("B" & CelModif.Row)) Is Nothing Then
    Application.EnableEvents = False
    Cells(LigDest, CelModif.Column).Formula = "=AVERAGE(" & Plage.Offset(, CelModif.Column - 2).Address(0, 0) & ")"
    Application.EnableEvents = True
End If
End Sub

1 pièce(s) jointe(s)

Hum... On progresse, y a pas de doute. Je crois ( mais ce n'est qu'un avis) que c'est sur la feuille que ça passe pas.

Le code de Daniel C fonctionne parfaitement, tant qu'il n'est pas sur la feuille.
Tel quel, il fait sauter Excel alors j'ai essayé le code suivant pour voir.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("2:27")) Is Nothing Then Call essai End If End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub essai() Dim Col As Integer With Worksheets("SYN") Col = .Range("2:27").Find("*", , , , xlByColumns, xlPrevious).Column .Range("B28").FormulaLocal = "=MOYENNE(B4;B5;B10;B11;B13;B14;B15;B16;B18;B19;B21;B25;B27)" .Range("B28").AutoFill Destination:=.Range(.Cells(28, 2), .Cells(28, Col)) End With End Sub
Et là,rien ne se déclenche, aucune réaction.
Conclusion, je ne sais pas mettre une macro dans une feuille :cry:

16/01/2013, 15h18
mercatog

Pour le code que j'avais proposé, il faut le mettre dans le module de la feuille SYN

Aussi, il faudra adapter le formule de la ligne 29.

Alors moi je suis perdue... Un coup ça passe, un coup ça passe pas! Toujours est-il que pour le moment ça passe alors...

Merci à tous les deux pour votre aide (même si j'ai pas encore tout compris...)

Pour les intéressés:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
'Pour étirer une formule s'il y a au moins une valeur dans la colonne
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
If Target.Count = 1 Then
    If Target.Value <> "" Then
        Application.EnableEvents = False
        Remplir 28, Range("B4,B5,B10,B11,B13,B14,B15,B16,B18,B19,B21,B25,B27"), Target
        Remplir 29, Range("B2,B6,B7,B12,B17,B20,B22,B23,B24,B26"), Target
        Application.EnableEvents = True
    End If
End If
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
'LigDest: ligne 28 ou 29
'Plage: Plage à moyenner
'CelModif: Cellule modifiée
Private Sub Remplir(ByVal LigDest As Integer, ByVal Plage As Range, ByVal CelModif As Range)
 
If Not Intersect(Plage, Range("B" & CelModif.Row)) Is Nothing Then
    Application.EnableEvents = False
    Cells(LigDest, CelModif.Column).Formula = "=AVERAGE(" & Plage.Offset(, CelModif.Column - 2).Address(0, 0) & ")"
    Application.EnableEvents = True
End If
End Sub

Et maintenant je peux dire ce mot que j'adore... Résolu ! :ccool:

16/01/2013, 16h11
Daniel.C

C'est mercatog qui a mis le doigt dessus. Il fallait mettre :

Code:

Application.EnableEvents = False

pour éviter que le changement de valeur d'une cellule ne provoque une nouvelle exécution de la macro.

(et rétablir à "True" après.)

Petite explication

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
'La procédure suivante permet d'écrire la formule dans la cellule Cell(X, Y)
'Avec X: la ligne de destination de la formule (pour ton cas soit la ligne 28 ou la ligne 29)
'Y: la colonne correspondant à la cellule modifiée dans le tableau B2:XX27)
'Mais on est dans le cas où la cellule modifiée n'est pas forcément prise en compte dans la formule
'd'où la necessité de comparer si la cellule modifiée appartient à la plage (variable Plage) prise pour la formule
'En fait Plage correspondant à la formule de la colonne B. Exemple Range("B4,B5,B10,B11,B13,B14,B15,B16,B18,B19,B21,B25,B27")
'Si on fait pas ce test, la modification de la cellule B7 par exemple, inscrira la formule alors qu'elle n'intervient pas dans la moyenne
'On aura donc #DIV/0!
 
'LigDest: ligne 28 ou 29
'Plage: Plage à moyenner
'CelModif: Cellule modifiée
Private Sub Remplir(ByVal LigDest As Integer, ByVal Plage As Range, ByVal CelModif As Range)
 
'Si la ligne de la cellule modifié coupe Plage. càd la cellule sera prise en compte dans la formule
If Not Intersect(Plage, Range("B" & CelModif.Row)) Is Nothing Then
    'on écrit la formule dans la cellule correspondante
    'Plage.Offset(, CelModif.Column - 2).Address(0, 0) étant l'adresse de la plage de cellules décalée de CelModif-2 à droite
    'Exemple, si on modifie la cellule D13, la ligne 13 a une intersection avec Plage qui est Range("B4,B5,B10,B11,B13,B14,B15,B16,B18,B19,B21,B25,B27")
    'Donc on aura une moyenne à transcrire
    'càd: Cells(28,4).formula="=AVERAGE(" & Range("B4,B5,B10,B11,B13,B14,B15,B16,B18,B19,B21,B25,B27").Offset(, 2).Address(0, 0) & ")"
    'càd: Cells(28,4).formula="=AVERAGE(D4,D5,D10,D11,D13,D14,D15,D16,D18,D19,D21,D25,D27)"
    Cells(LigDest, CelModif.Column).Formula = "=AVERAGE(" & Plage.Offset(, CelModif.Column - 2).Address(0, 0) & ")"
End If
End Sub