Zone de recherche

Question

Comment puis-je définir une zone de recherche située entre deux dates dans un calendrier ? Je joins un petit fichier. un grand merci de vous pencher sur mon problème. Papy Pierrot...

Yvouille · Answer

Tes demandes ne sont jamais très claires. Tu places une partie de ta demande sur ton fil, une partie dans le fichier (mais alors il faut bien cherche ce qui fait partie de ta question, ce qui fait partie des instructions à l’attention de l’utilisateur du fichier), ce qui complique bien les choses. Reste donc plutôt sur ton fil pour donner les instructions, les choses seront plus claires. Ensuite, si ton texte dans ton rectangle jaune est bien des instructions, tu parles d’un code, mais l’on ne sait pas duquel tu parles. Comme tu sembles nous fournir des fichiers avec tous plein d’essais de code, c’est assez difficile de savoir lequel te cause du souci actuellement. Prends donc l’habitude d’être précis et d’utiliser les références aux objets Excel (Cellule, Feuille, Ligne, Macro, UserForm, TextBox, etc.). Mais précise également quelle partie d’un code fonctionne, laquelle non. Quand tu dis : ‘Quand on date la date de début et la date de fin (entre 2009 et 2020 icii), le code génère dans les cellules conserné combien il y a de rouge, de bleu et de blanc. Je ne voit pas comment on peut faire?’ on ne sais pas si ton code génère ce que tu désires mais que tu voudrais que l’on t’explique comment cela est généré ou si tu veux nous dire d’une manière spéciale que ton code devrait générer quelque chose qu’il ne génère pas. J’ai bien essayé de voir tes codes reliés aux boutons ‘Nombre rouge’ et ‘Nombre blanc’ mais j’ai vite laissé tomber voyant que ce sont des codes assez abracadabrants ; donc probablement des essais avortés ?? Qu’entends-tu par ‘Quand on date la date de début et de fin’ ? Veux-tu dire ‘Quand on inscrit une date de début et de fin en AU9 et en AU12’ ?? A te relire...

Yvouille · Answer

Ok, c'est déjà un peu plus clair. Je n'ai malheureusement pas le temps de voir ça avant demain ou après demain. Mais je m'en occupe, promis...

Yvouille · Answer

Re-salut,

J’ai modifié l’orthographe des mois d’août et j’ai inscrit le 29 février les années bissextiles.

Si je t’ai bien compris, le code ci-dessous devrait faire l’affaire.

Si tu lances la macro avec les dates extrêmes en place, ça trouve un total de 4383 cellules des 3 couleurs possibles ; selon un contrôle sur la feuille 2, il y a effectivement ce nombre de dates dans cette période.

Amicalement.

Sub xx()
Dim i As Integer, j As Integer, k As Integer, m As Byte, n As Byte
Dim Année_traitée As Integer, Ligne_des_mois As Integer, Ligne_Semaine_traitée As Integer, Mois_traité As Integer
Dim Colonne_Jour_traité As Byte, Date_traitée As Date
Dim Compteur_Rouge As Integer, Compteur_Blanc As Integer, Compteur_Bleu As Integer

For i = 1 To 144 Step 13 'De l'année 2009 à l'année 2020
    Année_traitée = Cells(i, 1)
    For j = 1 To 7 Step 6 'D'abord les 6 premiers mois, puis les 6 derniers
        Ligne_des_mois = i + j
            For k = 1 To 36 Step 7 '6 mois à la fois
                If Cells(Ligne_des_mois, k) = "Janvier" Then
                    Mois_traité = 1
                ElseIf Cells(Ligne_des_mois, k) = "Février" Then
                    Mois_traité = 2
                ElseIf Cells(Ligne_des_mois, k) = "Mars" Then
                    Mois_traité = 3
                ElseIf Cells(Ligne_des_mois, k) = "Avril" Then
                    Mois_traité = 4
                ElseIf Cells(Ligne_des_mois, k) = "Mai" Then
                    Mois_traité = 5
                ElseIf Cells(Ligne_des_mois, k) = "Juin" Then
                    Mois_traité = 6
                ElseIf Cells(Ligne_des_mois, k) = "Juillet" Then
                    Mois_traité = 7
                ElseIf Cells(Ligne_des_mois, k) = "Août" Then
                    Mois_traité = 8
                ElseIf Cells(Ligne_des_mois, k) = "Septembre" Then
                    Mois_traité = 9
                ElseIf Cells(Ligne_des_mois, k) = "Octobre" Then
                    Mois_traité = 10
                ElseIf Cells(Ligne_des_mois, k) = "Novembre" Then
                    Mois_traité = 11
                ElseIf Cells(Ligne_des_mois, k) = "Décembre" Then
                    Mois_traité = 12
                End If
                    For m = 1 To 5 'Pour 5 semaines
                        Ligne_Semaine_traitée = Ligne_des_mois + m
                        For n = 1 To 7 '7 jours de la semaine
                            Colonne_Jour_traité = k + n - 1
                            If Cells(Ligne_Semaine_traitée, Colonne_Jour_traité) <> "" Then
                                Date_traitée = DateSerial(Année_traitée, Mois_traité, Cells(Ligne_Semaine_traitée, Colonne_Jour_traité))
                                If Date_traitée >= Range("AU9") And Date_traitée <= Range("AU12") Then
                                    If Cells(Ligne_Semaine_traitée, Colonne_Jour_traité).Interior.ColorIndex = 3 Then 'rouge
                                        Compteur_Rouge = Compteur_Rouge + 1
                                    ElseIf Cells(Ligne_Semaine_traitée, Colonne_Jour_traité).Interior.ColorIndex = 2 Then 'Blanc
                                        Compteur_Blanc = Compteur_Blanc + 1
                                    Else
                                        Compteur_Bleu = Compteur_Bleu + 1
                                    End If
                                End If
                            End If
                        Next n
                    Next m
            Next k
    Next j
Next i

Range("AU16") = Compteur_Rouge
Range("AU19") = Compteur_Blanc
Range("AU22") = Compteur_Bleu

End Sub

23test-2.xlsm (99.28 Ko)

Benead · Answer

Histoire de réduire les lignes de code, on peut substituer tous les la recherche du mois (If... ElseIf... ElseIf...End If) qui est sur 25 lignes par ceci : En début de procédure : Dim aMois As Variant aMois = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Décembre") Et la recherche du mois retourne l'index du tableau : Mois_traité = WorksheetFunction.Match(Cells(Ligne_des_mois, k), aMois, 0)...