Besoin d'aide pour améliorer un code vba

**chrisl0** · 15/02/2017, 16h38

Bien le bonjour

Voila je suis entrain de faire un calendrier de réservation pour un camping pour la partie coter feuille de calcule pas de problème mais coter vba j'ai quelques soucis.

Mon calendrier vas de 2016 à 2050 la partie vba reprend des stats pour les mettres dans une autre feuille. J'arrive à le faire mais le problème est de 2016 a 2050 sa fait pas mal de ligne

Donc je cherche une facon de faire pour avoir de lignes

le code qui est juste sur deux ans

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
 
Dim CalendrierMois
Dim CalendrierAnnée
Dim NomFeuille
 
Private Sub Worksheet_Activate()
    If Range("D1") = "" Then
        ThisWorkbook.RefreshAll
    End If
 
End Sub
 
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    CalendrierMois = Range("H1").Value
    CalendrierAnnée = Range("D1").Value
    NomFeuille = "Stats"
    If CalendrierAnnée = "2017" Then
        If CalendrierMois = "Janvier" Then
            Worksheets(NomFeuille).[B3] = Range("AH16").Value
            Worksheets(NomFeuille).[C3] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Février" Then
            Worksheets(NomFeuille).[B4] = Range("AH16").Value
            Worksheets(NomFeuille).[C4] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Mars" Then
            Worksheets(NomFeuille).[B5] = Range("AH16").Value
            Worksheets(NomFeuille).[C5] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Avril" Then
            Worksheets(NomFeuille).[B6] = Range("AH16").Value
            Worksheets(NomFeuille).[C6] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Mai" Then
            Worksheets(NomFeuille).[B7] = Range("AH16").Value
            Worksheets(NomFeuille).[C7] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Juin" Then
            Worksheets(NomFeuille).[B8] = Range("AH16").Value
            Worksheets(NomFeuille).[C8] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Juillet" Then
            Worksheets(NomFeuille).[B9] = Range("AH16").Value
            Worksheets(NomFeuille).[C9] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Août" Then
            Worksheets(NomFeuille).[B10] = Range("AH16").Value
            Worksheets(NomFeuille).[C10] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Septembre" Then
            Worksheets(NomFeuille).[B11] = Range("AH16").Value
            Worksheets(NomFeuille).[C11] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Octobre" Then
            Worksheets(NomFeuille).[B12] = Range("AH16").Value
            Worksheets(NomFeuille).[C12] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Novembre" Then
            Worksheets(NomFeuille).[B13] = Range("AH16").Value
            Worksheets(NomFeuille).[C13] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Décembre" Then
            Worksheets(NomFeuille).[B14] = Range("AH16").Value
            Worksheets(NomFeuille).[C14] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        End If
    End If
 
    If CalendrierAnnée = "2018" Then
        If CalendrierMois = "Janvier" Then
            Worksheets(NomFeuille).[D3] = Range("AH16").Value
            Worksheets(NomFeuille).[E3] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Février" Then
            Worksheets(NomFeuille).[D4] = Range("AH16").Value
            Worksheets(NomFeuille).[E4] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Mars" Then
            Worksheets(NomFeuille).[5] = Range("AH16").Value
            Worksheets(NomFeuille).[E5] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Avril" Then
            Worksheets(NomFeuille).[D] = Range("AH16").Value
            Worksheets(NomFeuille).[E6] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Mai" Then
            Worksheets(NomFeuille).[D7] = Range("AH16").Value
            Worksheets(NomFeuille).[E7] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Juin" Then
            Worksheets(NomFeuille).[D8] = Range("AH16").Value
            Worksheets(NomFeuille).[E8] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Juillet" Then
            Worksheets(NomFeuille).[D9] = Range("AH16").Value
            Worksheets(NomFeuille).[E9] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Août" Then
            Worksheets(NomFeuille).[D10] = Range("AH16").Value
            Worksheets(NomFeuille).[E10] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Septembre" Then
            Worksheets(NomFeuille).[D11] = Range("AH16").Value
            Worksheets(NomFeuille).[E11] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Octobre" Then
            Worksheets(NomFeuille).[D12] = Range("AH16").Value
            Worksheets(NomFeuille).[E12] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Novembre" Then
            Worksheets(NomFeuille).[D13] = Range("AH16").Value
            Worksheets(NomFeuille).[E13] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Décembre" Then
            Worksheets(NomFeuille).[D14] = Range("AH16").Value
            Worksheets(NomFeuille).[E14] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        End If
    End If
End Sub

merci pour votre aide

**Menhir** · 15/02/2017, 16h59

Commence par mettre tes mois en numérique (perso, je les mettrais même en date en jouant sur le format), sinon il faudra mettre en Select Case pour renseigner la variable Mois.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim Mois As Integer, Annee As Integer
 
   Mois = Range("H1").Value
   Annee = Range("D1").Value
 
   Worksheets("Stats").Cells(2 + Mois, Annee - 2015) = Range("AH16").Value
   Worksheets("Stats").Cells(2 + Mois, Annee - 2014) = Range("AI16").Value
   Range("AH19").Value = Worksheets("Stats").Cells(15, Annee - 2015).Value
   Range("AI19").Value = Worksheets("Stats").Cells(15, Annee - 2015).Value
End Sub

**clementmarcotte** · 15/02/2017, 21h56

Bonjour,

Envoyé par Menhir

Commence par mettre tes mois en numérique (perso, je les mettrais même en date en jouant sur le format),

Ou bien avec DatePart ou avec Month

**mercatog** · 15/02/2017, 22h19

En 2017 faire en vba un calendrier qui va jusqu'à 2050 c'est comme faire en 1983 en basic un code en prévision de 2016

Invité · 15/02/2017, 22h44

Bonsoir,
Si tu as des réservations jusqu'à 2050 encaisses le chèques de réservation et tire toi!

Qu'est qui justifie 2050?

**chrisl0** · 16/02/2017, 12h04

Bonjour merci pour vos réponses

pour le coup je suis partis sur select case

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Select Case CalendrierAnnée
    Case 2017
        a = "B"
        b = "C"
    Case 2018
        a = "D"
        b = "E"
    End Select
    Select Case Calendriermois
    Case "Janvier"
    c = 3
     Case "Février"
    c = 4
     Case "Mars"
    c =5
    End Select
 
            Worksheets(NomFeuille).Range(a & c) = Range("AH16").Value
            Worksheets(NomFeuille).Range(b & c) = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value 'pas besoin de répéter ces 2 lignes
            [AI19] = Worksheets(NomFeuille).Range("C15").Value

Pourquoi 2050 je voulais quelque chose ou je ne suis pas obliger de revenir dessus dans 5 ou 10 ans. comme j'ai un projet personnel entre maintenant et la création de ma boite je préfère mi prendre maintenant. Car quand je vois le temps que je viens de passer a créer le projet excel j'ai pas envie de perdre se temps quand je vais créer ma boite.

Voila pourquoi, après j'ai peux être vue un peut trop loin

Maintenant j'ai une autre question, je viens de m’apercevoir que je suis obliger de cliquer sur une cellule pour mettre a jour l'autre feuille ou sont stocker les données.
Ma question est: comment avec la liste déroulante pour sélectionné le mois et l'année que sa stocke mes données sans à avoir a cliquer sur une cellule ??

merci a vous

Invité · 16/02/2017, 12h34

Envoyé par chrisl0

Bonjour merci pour vos réponses

Pourquoi 2050 je voulais quelque chose ou je ne suis pas obliger de revenir dessus dans 5 ou 10 ans. comme j'ai un projet personnel entre maintenant et la création de ma boite je préfère mi prendre maintenant. Car quand je vois le temps que je viens de passer a créer le projet excel j'ai pas envie de perdre se temps quand je vais créer ma boite.

bonjour,
tu ne compte pas faire de profits? tu ne compte pas si tu gagne de l'argents investir dans un outils genre caisse enregistreuse comme pour les réservations d’hôtel?

2050 tu envisage ta succession? t'oublis pas de te rendre chez le notaire pour rédiger ton testament! remarque (chrisl0) on est jamais trop prudent le christ est mort à 33 ans (2050 - 2017=33)!

**chrisl0** · 16/02/2017, 12h38

Re si bien-sur que je compte faire des profits mais quand tu peux le faire toi même pourquoi acheter des truc tout fait ??

**Menhir** · 16/02/2017, 17h41

Envoyé par clementmarcotte

Ou bien avec DatePart ou avec Month

Etant donné qu'il n'a pas des vraies dates mais des mois écrits en littéral, ces fonctions sont inutilisables.
J'avais pensé passer par un DateValue (puis un Month) mais il y a 90% de chance que ça ne marche pas, surtout avec des mois écrits en français.

Envoyé par chrisl0

pour le coup je suis partis sur select case

Pour les numéro d'années, une formule serait plus pratique.
A mettre dans un Cells plutôt qu'un Range pour ne pas avoir à mettre les colonnes en lettres.

Maintenant j'ai une autre question, je viens de m’apercevoir que je suis obliger de cliquer sur une cellule pour mettre a jour l'autre feuille ou sont stocker les données.
Ma question est: comment avec la liste déroulante pour sélectionné le mois et l'année que sa stocke mes données sans à avoir a cliquer sur une cellule ??

Pas vraiment claire ta question...

Mais je pense que tu dois pouvoir résoudre ça avec une macro évènementielle Worksheet_Change.
https://msdn.microsoft.com/fr-fr/lib.../ff839775.aspx

Besoin d'aide pour améliorer un code vba [XL-2016]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager