Eviter de répeter du code dans fonction

Version imprimable

Bonjour,

J'essaye d'alléger mon code, j'aimerais mettre un fonction qui m'incrémente, lorsque j'appelle ma fonction, un chiffre de 1 à 12 (représentant les mois de l'année)

Code:

1
2
3
4
5
6
7
8
Sub text1()
Dim i As Integer
i = 1
Do Until i = 12
Call comptercellules(2013, i)
i = i + 1
Loop
End Sub

J'ai pas envie à chaque fois de réécrire la ligne call pour chaque mois.
Alors j'ai essayé avec la fonction Do mais j'ai l'impression que je peux pas mettre de i à l'interieur.

Code:

1
2
3
4
5
6
7
Sub text1()
Call comptercellules(2013, 1)
Call comptercellules(2013, 2)
Call comptercellules(2013, 3)
Call comptercellules(2013, 4)
..........
End Sub

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Function comptercellules(strtext As String, strtext1 As String) As Long
'Dim comptercellules As Integer
Dim Cellules As Range
Dim LaDerniere As Integer
Dim i As Integer
 
 
        LaDerniere = Worksheets("CUR SEMAINE").Cells(56555, 1).End(xlUp).Row
 
        For i = 1 To LaDerniere
 
        If Month(Range("A" & i).Value) = strtext1 And Year(Range("A" & i).Value) = strtext Then   ' modifiez le code couleur 38 par celui de votre choix
            comptercellules = comptercellules + 1
            End If
 
               Next i
 
Dim Plage As Range
 
  For Each Cellules In Worksheets("Feuil1").Range("a1:a" & Worksheets("Feuil1").Range("a" & Worksheets("Feuil1").Rows.Count).End(xlUp).Row)
    If Month(Cellules) = strtext1 And Year(Cellules) = strtext Then
      If Plage Is Nothing Then Set Plage = Cellules(1, 2) Else Set Plage = Union(Plage, Cellules(1, 2))
    End If
 
  Next Cellules
  Worksheets("Feuil1").Select
  If Not Plage Is Nothing Then Plage.Select
  Plage.Value = comptercellules
 
End Function
 
 
Sub text1()
Dim i As Integer
 
i = 1
Do Until i = 12
Call comptercellules(2013, i)
i = i + 1
Loop
 
End Sub

20/04/2010, 14h35
Minick

Salut,

Attention, une fonction ne devrait (ne doit) servir qu'a renvoyer une valeur et pas a modifier ton classeur.
Ensuite, le type des arguments passes a cette fonction devrait etre un integer pour l'annee et un Byte pour les mois

De plus je ne comprend pas bien le but de ton code.
Dans un premier temps tu comptes les cellules correspondantes a tes criteres
et ensuite par une boucle similaire tu "crees" la plage pour lui affecter la valeur du compteur.

Peux tu preciser ton but?
20/04/2010, 15h07
adriennoob

Mon code me permet de compter le nombre de ligne dans la feuille "CUR SEMAINE" en faisant la somme en fonction du mois et de l'année (ex: le nombre de ligne éditer en avril 2010 = 5).
Puis cette valeur je la copie dans un autre classeur en face de la date concernée (ici c'est la cellule "avril 2010 " de "Feuil1".)

Donc d'abord je compte, ensuite je recherche dans l'autre classeur la date similaire, et ensuite je copie.

C'est mieux???:ccool:
20/04/2010, 15h59
sabzzz
bonjour ,

il faut faire attention au declaration de variable pour que cela fonctionne,
dans l'exemple ci-dessous tu remarquera que les variables x et i sont declarer Variant
Code:

1 2 3 4 5 6 Sub test1() Dim y As Integer, i As Variant For i = 1 To 12 y = addition(2, i) Next End Sub
Code:

1 2 3 Function addition(a As Integer, x As Variant) As Integer addition = a + x End Function

Re,

Un exemple de correction d'apres ton code initial:

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Option Explicit
 
Function comptercellules(intAnnee As Integer, bytMois As Byte) As Long
    Dim LaDerniere As Long, i As Long
 
    With Worksheets("CUR SEMAINE")
        LaDerniere = .Range("A" & .Rows.Count).End(xlUp).Row
 
        For i = 1 To LaDerniere
            If Month(.Range("A" & i).Value) = bytMois And Year(Range("A" & i).Value) = intAnnee Then
                comptercellules = comptercellules + 1
            End If
        Next i
    End With
End Function
 
Sub text1()
    Dim Plage As Range, Cellules As Range
    Dim bytMois As Byte
    Dim intAnnee As Integer
 
    With Worksheets("Feuil1")
        intAnnee = 2013
 
        bytMois = 1
        Do Until bytMois = 12
            For Each Cellules In .Range("a1:a" & .Range("a" & .Rows.Count).End(xlUp).Row)
                If Month(Cellules) = bytMois And Year(Cellules) = intAnnee Then
                    If Plage Is Nothing Then
                        Set Plage = Cellules(1, 2)
                    Else
                        Set Plage = Union(Plage, Cellules(1, 2))
                    End If
                End If
            Next Cellules
 
            If Not Plage Is Nothing Then
                Plage.Value = comptercellules(intAnnee, bytMois)
                Set Plage = Nothing
            End If
            bytMois = bytMois + 1
        Loop
    End With
End Sub

Mais on pourrait eviter la fonction de comptage des cellules comme 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
24
25
26
Option Explicit
 
Sub Test2()
    Dim Cellules As Range
    Dim bytMois As Byte
    Dim intAnnee As Integer
    Dim strNom As String
    Dim lngDerLigne As Long, lngCompteur As Long
 
    With Worksheets("CUR SEMAINE")
        lngDerLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        strNom = .Name
    End With
 
    With Worksheets("Feuil1")
        intAnnee = 2013
        For bytMois = 1 To 12
            lngCompteur = Evaluate("SUMPRODUCT((MONTH('" & strNom & "'!R1C1:R" & lngDerLigne & "C1)=" & bytMois & ")*(YEAR('" & strNom & "'!R1C1:R" & lngDerLigne & "C1)=" & intAnnee & ")*1)")
            For Each Cellules In .Range("a1:a" & .Range("a" & .Rows.Count).End(xlUp).Row)
                If Month(Cellules) = bytMois And Year(Cellules) = intAnnee Then
                    Cellules.Offset(, 1).Value = lngCompteur
                End If
            Next Cellules
        Next bytMois
    End With
End Sub

Avec le meme resultat...

20/04/2010, 16h32
adriennoob

Heu d'accord !!!! :roll:

C'est balèze, c'est sur que c'est plus jolie...:mouarf:

Par contre pour pas rester bête c'est quoi ce

Code:

........R1C1:R.......

Et ton premier code marche nikel, par contre le deuxième mais une erreur de type ici

Code:

lngCompteur = Evaluate("SUMPRODUCT((MONTH('" & strNom & "'!R1C1:R" & lngDerLigne & "C1)=" & bytMois & ")*(YEAR('" & strNom & "'!R1C1:R" & lngDerLigne & "C1)=" & intAnnee & ")*1)")

Merci
20/04/2010, 17h43
Minick

Cette ligne revient en fait a utiliser la fonction SOMMEPROD d'excel (en anglais pour vba)

Cela equivaut donc pour le 1er mois de 2013 a:

Code:

SUMPRODUCT((MONTH('CUR SEMAINE'!R1C1:R48C1)=1)*(YEAR('CUR SEMAINE'!R1C1:R48C1)=2013)*1)

Ou R1C1 correspond a la Cellule A1 et R48C1 la cellule A48
48 parceque mon jeu de test n'allait pas plus loin.

R1C1 est l'equivalent en notation anglaise de L1C1 (dans les options excel)

Concernant l'erreur de type, difficile a voir sans ton fichier, il y a peut etre une cellule ne contenant pas une date mais du texte ou un chiffre.
21/04/2010, 09h06
adriennoob

merci a toi