Worksheetfunction countif
Bonjour a toutes et a tous !
Je suis actuellement bloquer sur une condition if.
En gros je voudrais que mon WorksheetFunction.CountIf(.Range("C12"), "RT*") = 1 .
Le mot de la condition commence par RT mais il peut y avoir d'autre lettre ou chiffre derrière.
Sa fait 2 jours que je recherche sur un worksheetfunction cette méthode.
Merci a vous !
21FormaticPassionné d'Excel
- Messages
- 3'678
- Excel
- 365, 2019
- Inscrit
- 11/04/2020
- Emploi
- Formateur bureautique, dvpt de fichiers
Bonjour,
Que veux-tu que nous fassions avec ce tout petit bout de code seulement ?
tu mets .range...
As-tu auparavant mis with ..... ? Sinon, essaie en enlevant le "."
Parce qu'à part ça, ça marche ...
Bonjour,
Ta syntaxe est à priori correcte, mais ton exemple trop restrictif pour nous permettre de comprendre. Quel est l'objectif ? Peux tu fournir un code plus exhaustif, voire un classeur ?
S'il s'agit de vérifier si la cellule C12 commence par RT, voilà quelques méthodes possibles :
If UCase(Left(.Range("C12"), 2)) = "RT") Then MsgBox "Gnagnagna"If UCase(.Range("C12")) Like "RT*" Then MsgBox "Gnagnagna"If InStr(UCase(.Range("C12")), "RT") = 1 Then MsgBox "Gnagnagna"If InStr(.Range("C12"), "RT", 1) = 1 Then MsgBox "Gnagnagna"PS : UCase permet de passer en majuscule, mais bien souvent les comparaisons ne sont pas sensibles à la casse (sauf InStr en l'absence d'un "1" dans le dernier paramètre).
Edit : salut JoyeuxNoel
21FormaticPassionné d'Excel
- Messages
- 3'678
- Excel
- 365, 2019
- Inscrit
- 11/04/2020
- Emploi
- Formateur bureautique, dvpt de fichiers
Salut Pedro !
J'ai été un peu plus expéditif que toi... 😁
Voila le code complet
Bon c'est un peu la pagaille le code .
Sub remplir()
Application.ScreenUpdating = True
Dim myPath As String, myFile As Variant 'Declaration de variable pour ouvrir fichier
myPath = "C:\Users\babyb\OneDrive\Bureau\Prevision\" 'mon chemin
myFile = Dir(myPath & "\Groupe*.xls*") 'mon fichier (commence par groupe)
compteur9 = 0 ' compteur de 9h
compteur6 = 0
Do While myFile <> "" 'tant qu'il y a des fichier
Dim wb As Workbook
Dim ws As Worksheets
Set wb = Workbooks.Open(myPath & myFile) 'ouvre le fichier
wb.Activate 'active le classeur
Dim WS_Count As Integer ' variable nombre de feuilles
Dim I As Integer '
WS_Count = ActiveWorkbook.Worksheets.Count ' la variable est egale au nombre de feuille compter dans le classeur
For I = 1 To WS_Count ' De la premiere feuille a la derniere feuille compter
With ActiveWorkbook.Worksheets(I) ' avec la feuille active
If ActiveWorkbook.Worksheets(I).Name = "EX 141" Then 'si le nom de la feuille est
GoTo suite
ElseIf ActiveWorkbook.Worksheets(I).Name = "EX" Then 'pareil
GoTo suite
ElseIf Left(ActiveWorkbook.Worksheets(I).Name, 4) = "feui" Then 'si la feuille commence par
GoTo suite
ElseIf Left(ActiveWorkbook.Worksheets(I).Name, 4) = "Feui" Then 'pareille
GoTo suite
Else
If WorksheetFunction.CountIf(.Range("C8"), "9") = 1 Then 'And WorksheetFunction.CountIf(.Range("C10:C13"), "") = 1) Or WorksheetFunction.CountIf(.Range("C10:C13"), "1") = 1 Then si il vois la position 9 sans rien d autre
If WorksheetFunction.CountBlank(.Range("C10:C11")) <> 2 Or WorksheetFunction.CountBlank(.Range("C13")) <> 1 Then
compteur9 = compteur9
ElseIf WorksheetFunction.CountIf(.Range("C9"), "0") = 1 Then
compteur9 = compteur9
ElseIf WorksheetFunction.CountIf(.Range("C12"), "F") = 1 Or WorksheetFunction.CountIf(.Range("C12"), "FOR") = 1 Or WorksheetFunction.CountIf(.Range("C12"), "MAD") = 1 Or WorksheetFunction.CountIf(.Range("C12"), "MADOM") = 1 Then
compteur9 = compteur9
Else
compteur9 = compteur9 + 1
End If
End If
If WorksheetFunction.CountIf(.Range("C8"), "9/6") = 1 Then
compteur6 = compteur6 + 1
End If
If WorksheetFunction.CountIf(.Range("C8"), "6") = 1 Then
If WorksheetFunction.CountBlank(.Range("C10:C11")) <> 2 Or WorksheetFunction.CountBlank(.Range("C13")) <> 1 Then
compteur6 = compteur6
ElseIf WorksheetFunction.CountIf(.Range("C9"), "0") = 1 Then
compteur6 = compteur6
ElseIf WorksheetFunction.CountIf(.Range("C12"), "F") = 1 Or WorksheetFunction.CountIf(.Range("C12"), "FOR") = 1 Or WorksheetFunction.CountIf(.Range("C12"), "MAD") = 1 Or WorksheetFunction.CountIf(.Range("C12"), "MADOM") = 1 Or WorksheetFunction.CountIf(.Range("C12"), "RT*") = 1 Then
compteur6 = compteur6
MsgBox ActiveWorkbook.Worksheets(I).Name
Else
compteur6 = compteur6 + 1
' MsgBox ActiveWorkbook.Worksheets(I).Name
End If
End If
End If
End With
suite:
Next I
myFile = Dir()
Loop
Range("A1") = compteur9
Range("A2") = compteur6
End SubJe débute en programmation du coup je fais des gros pavé et c'est surement pas optimiser mais sa seras pour plus tard.
Je teste ta solution Pedro !
21FormaticPassionné d'Excel
- Messages
- 3'678
- Excel
- 365, 2019
- Inscrit
- 11/04/2020
- Emploi
- Formateur bureautique, dvpt de fichiers
De ce que je vois, tu as juste à enlever les points devant les range, et ça devrait tourner.
Après, bien évidemment, les solutions de Pedro seront bien meilleures pour ce que tu attends.
Edit : ses 2 premières propositions devraient très bien aller (surtout s'il rajoute ,2 à sa fonction left
Si j’enlève les points avant les ranges ca va pas chercher dans les classeur extérieur .
21FormaticPassionné d'Excel
- Messages
- 3'678
- Excel
- 365, 2019
- Inscrit
- 11/04/2020
- Emploi
- Formateur bureautique, dvpt de fichiers
Ah ? Tu vas chercher dans des classeurs extérieurs ?
C'est la d’où viens tout le problème ... et les boucle Do et For
EDIT : Merci pedro22 c'est bien sa !
Merci a toi aussi JoyeuxNoel
21FormaticPassionné d'Excel
- Messages
- 3'678
- Excel
- 365, 2019
- Inscrit
- 11/04/2020
- Emploi
- Formateur bureautique, dvpt de fichiers
Je ne suis pas expert VBA, mais je n'ai pas l'impression que tu ailles dans des fichiers "extérieurs", vu que le classeur que tu ouvres dans ta boucle devient le fichier actif.
Je penser que sa fonctionnais pas mais en faite normale j'ai fais le teste sur une case 6 et le groupe sur le quelle j'essayais etait en 9 !
Merci a vous !
Bon je suis qu'au début de mon travail va falloir que j'essaye d'automatiser les résultats sur des case en fonction des dates sur le classeur de destination mais bon je prefere me creuser la tête avant qu'on m'offre la solution .
Je fais sa pour occuper mes week end pas par obligation !
Bonjour,
J'ai essayé de déchiffrer un peu le code, et le moins que l'on puisse dire c'est qu'il est tordu !
Mes remarques :
- Application.ScreenUpdating = True 'Inutile d'activer l'affichage en début de macro... Il l'est forcément !
- On ne déclare pas de variables en cours de macro, surtout pas dans une boucle !
- Les variables compteurs ne sont pas déclarées
- Affecter un 0 comme première valeur d'une variable numérique est inutile, c'est la valeur par défaut
- wb.Activate est inutile, l'ouverture d'un classeur le rend directement actif
- L'indentation permet de rendre le code lisible et d'identifier l'imbrication des éléments : il faut l'utiliser !
- Utiliser une structure "With", c'est bien, mais si c'est pour répéter ensuite le nom de l'objet, ça n'a aucun intérêt :
With ActiveWorkbook.Worksheets(I) ' avec la feuille active
If ActiveWorkbook.Worksheets(I).Name = "EX 141" Then 'si le nom de la feuille est
'Devient :
With ActiveWorkbook.Worksheets(I) ' avec la feuille active
If .Name = "EX 141" Then 'si le nom de la feuille est- ça c'est tordu : If WorksheetFunction.CountIf(.Range("C8"), "9") = 1 then, il faut tout simplement écrire : If .Range("C8") = 9 Then
- ça c'est inutile : compteur9 = compteur9, sauf à part te perdre un peu plus dans ton code...
- Il serait judicieux de fermer le classeur avant de passer au suivant : wb.Close False
- Il faut préciser le classeur et la feuille où l'on inscrit compteur9 et compteur6
Un essai de correction (mais n'ayant pas compris tout le cœur du sujet, c'est surement à retravailler !) :
Sub remplir()
Dim myPath As String, myFile As Variant 'Declaration de variable pour ouvrir fichier
Dim wb As Workbook, ws As Worksheets
Dim compteur9 As Integer, compteur6 As Integer, I As Integer
myPath = "C:\Users\babyb\OneDrive\Bureau\Prevision\" 'mon chemin
myFile = Dir(myPath & "\Groupe*.xls*") 'mon fichier (commence par groupe)
Do While myFile <> "" 'tant qu'il y a des fichiers
Set wb = Workbooks.Open(myPath & myFile) 'ouvre le fichier
For I = 1 To WS_Count ' De la premiere feuille a la derniere feuille comptée
With wb.Worksheets(I) ' avec la feuille active
Select Case True
Case .Name = "EX 141", .Name = "EX", LCase(.Name) Like "feui*" 'si le nom de la feuille est
GoTo suite
Case Else
If .Range("C8") = 9 Then
If Application.CountBlank(.Range("C10:C11")) <> 2 Or Application.CountBlank(.Range("C13")) <> 1 Then compteur9 = compteur9 'NOTE : tout ça ne sert au final à rien...
ElseIf .Range("C9") = 0 Then compteur9 = compteur9 'NOTE : également inutile du coup...
ElseIf (.Range("C12") = "F" Or .Range("C12") = "FOR" Or .Range("C12") = "MAD" Or .Range("C12") = "MADOM") Then compteur9 = compteur9 'NOTE : encore inutile
Else: compteur9 = compteur9 + 1
End If
If .Range("C8") = "9/6" Then compteur6 = compteur6 + 1
If .Range("C8") = 6 Then
MsgBox .Name
If Application.CountBlank(.Range("C10:C11")) <> 2 Or Application.CountBlank(.Range("C13")) <> 1 Then compteur6 = compteur6 'NOTE : encore inutile
ElseIf .Range("C9") = 0 Then compteur6 = compteur6 'NOTE : encore inutile
ElseIf (.Range("C12") = "F" Or .Range("C12") = "FOR" Or .Range("C12") = "MAD" Or .Range("C12") = "MADOM") Then compteur6 = compteur6 'NOTE : encore inutile
Else: compteur6 = compteur6 + 1
End If
End Select
End With
suite:
Next I
'NOTE : on ne ferme pas le classeur ? wb.Close False
myFile = Dir()
Loop
Range("A1") = compteur9 'NOTE : Préciser le classeur et la feuille
Range("A2") = compteur6 'NOTE : idem
End Sub21FormaticPassionné d'Excel
- Messages
- 3'678
- Excel
- 365, 2019
- Inscrit
- 11/04/2020
- Emploi
- Formateur bureautique, dvpt de fichiers
Et pour la fonction left du coup, on peut se passer du ,2 ou pas ?
Et pour la fonction left du coup, on peut se passer du ,2 ou pas ?
Nan ! C'est pour vérifier si tu es attentif !
Je corrige...
Pedro22
J’étais parti pour faire la suite de mon projet (calculer tout les autre jour de l'année de mon autre feuille, pour les transposer sur ma feuille ou je doit avoir le nombre de présent)
Et la tu ma tout chambouler l'esprit, je sais que je code comme un débutant vu que je le suis , du coup j'ai copier coller ton code et la sa ne donne pas les bons résultat .
Du coup je vais retravailler sur ta base qui est beaucoup plus claire !
Mais la je fait une GRAAANDE pause ma calvitie va se creuser encore plus sinon !
Merci encore !
PS: sa sent le nouveau sujet bientôt pour le reste du projet
Je peut pas vous passer les autre classeur il y a des donnée confidentiel !
EDIT: Si je ne ferme pas les classeur c'est que je suis encore en phase de test
Pas de soucis il faut bien débuter. Avant de te lancer bille en tête dans un projet complexe, je te suggère de t'exercer sur des choses simples pour bien maitriser la logique et avoir un code à la fois clair et efficace. Ça t'évitera de reprendre 10 fois ton gros projet (et limiter ta calvitie
Voila ce que sa donne au final :
Dim mois, six, neuf As Integer
Dim LiC, I, LiP6, LiP9, compteur9, compteur6 As Integer 'ligne prevision 6h et 9h 'colone et ligne calendrier
Dim com9, com6, com5 As String
Sub prog()
Dim myPath As String, myFile As Variant 'Declaration de variable pour ouvrir fichier
For CoC = 3 To 33
myPath = ThisWorkbook.Path & "\" 'mon chemin
myFile = Dir(myPath & "\Groupe*.xls*") 'mon fichier (commence par groupe)
Do While myFile <> "" 'tant qu'il y a des fichier
Dim wb As Workbook, ws As Worksheets
Set wb = Workbooks.Open(myPath & myFile) 'ouvre le fichier
Dim WS_Count As Integer ' variable nombre de feuilles '
WS_Count = ActiveWorkbook.Worksheets.Count ' la variable est egale au nombre de feuille compter dans le classeur
For I = 1 To WS_Count ' De la premiere feuille a la derniere feuille compter
With ActiveWorkbook.Worksheets(I) ' avec la feuille active
Select Case True
Case .Name = "EX 141", .Name = "EX", LCase(.Name) Like "feui*"
GoTo suite
Case Else
If .Range(.Cells(LiC, CoC), .Cells(LiC, CoC)) = "9" Then ' si il vois la position 9 sans rien d autre
If WorksheetFunction.CountBlank(.Range(.Cells(LiC + 2, CoC), .Cells(LiC + 3, CoC))) <> 2 Or WorksheetFunction.CountBlank(.Range(.Cells(LiC + 5, CoC), .Cells(LiC + 5, CoC))) <> 1 Then
ElseIf .Range(.Cells(LiC + 1, CoC), .Cells(LiC + 1, CoC)) = "0" Then
ElseIf .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "F" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "FOR" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MAD" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MADOM" = 1 Or UCase(Left(.Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)), 2)) = "RT" Then
Else
compteur9 = compteur9 + 1
com9 = com9 + .Name & " / "
End If
End If
If .Range(.Cells(LiC, CoC), .Cells(LiC, CoC)) = "9/6" Then
compteur6 = compteur6 + 1
com6 = com6 + .Name & " / "
End If
If .Range(.Cells(LiC, CoC), .Cells(LiC, CoC)) = "6" Then
If WorksheetFunction.CountBlank(.Range(.Cells(LiC + 2, CoC), .Cells(LiC + 3, CoC))) <> 2 Or WorksheetFunction.CountBlank(.Range(.Cells(LiC + 5, CoC), .Cells(LiC + 5, CoC))) <> 1 Then
ElseIf .Range(.Cells(LiC + 1, CoC), .Cells(LiC + 1, CoC)) = "0" Then
ElseIf .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "F" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "FOR" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MAD" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MADOM" = 1 Or UCase(Left(.Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)), 2)) = "RT" Then
Else
compteur6 = compteur6 + 1
com6 = com6 + .Name & " / "
' MsgBox ActiveWorkbook.Worksheets(I).Name
End If
End If
If .Range(.Cells(LiC, CoC), .Cells(LiC, CoC)) = "5" Then
If WorksheetFunction.CountBlank(.Range(.Cells(LiC + 2, CoC), .Cells(LiC + 3, CoC))) <> 2 Or WorksheetFunction.CountBlank(.Range(.Cells(LiC + 5, CoC), .Cells(LiC + 5, CoC))) <> 1 Then
ElseIf .Range(.Cells(LiC + 1, CoC), .Cells(LiC + 1, CoC)) = "0" Then
ElseIf .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "F" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "FOR" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MAD" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MADOM" = 1 Or UCase(Left(.Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)), 2)) = "RT" Then
Else
compteur6 = compteur6 + 1
com6 = com6 + .Name & " / "
'MsgBox ActiveWorkbook.Worksheets(I).Name
End If
End If
If .Range(.Cells(LiC, CoC), .Cells(LiC, CoC)) = "5/9" Then
compteur9 = compteur9 + 1
com9 = com9 + .Name & " / "
End If
End Select
End With
suite:
Next I
myFile = Dir()
Loop
Range(Cells(LiP6, six), Cells(LiP6, six)) = compteur6
Range(Cells(LiP6, six), Cells(LiP9, six)).ClearComments
Range(Cells(LiP6, six), Cells(LiP9, six)).AddComment
Range(Cells(LiP6, six), Cells(LiP9, six)).Comment.Visible = False
Range(Cells(LiP6, six), Cells(LiP9, six)).Comment.Text Text:="Agents Presents:" & Chr(10) & com6
Range(Cells(LiP9, neuf), Cells(LiP9, neuf)) = compteur9
Range(Cells(LiP9, neuf), Cells(LiP9, neuf)).ClearComments
Range(Cells(LiP9, neuf), Cells(LiP9, neuf)).AddComment
Range(Cells(LiP9, neuf), Cells(LiP9, neuf)).Comment.Visible = False
Range(Cells(LiP9, neuf), Cells(LiP9, neuf)).Comment.Text Text:="Agents Presents:" & Chr(10) & com9
LiP6 = LiP6 + 1
LiP9 = LiP9 + 1
compteur9 = 0
compteur6 = 0
com9 = ""
com6 = ""
Next CoC
Call fermer
End Sub
Sub Modif6premiermois()
LiP9 = 5
LiP6 = 5
LiC = mois
com = ""
Call prog
End Sub
Sub Modif6derniersmois()
LiP9 = 38
LiP6 = 38
LiC = mois
Call prog
End Sub
Sub JanviertoJuin()
LiP9 = 5
LiP6 = 5
LiC = 8
mois6 = 2
mois9 = 3
Dim myPath As String, myFile As Variant 'Declaration de variable pour ouvrir fichier
For L = 1 To 6
For CoC = 3 To 33
myPath = ThisWorkbook.Path & "\" 'mon chemin
myFile = Dir(myPath & "\Groupe*.xls*") 'mon fichier (commence par groupe)
Do While myFile <> "" 'tant qu'il y a des fichier
Dim wb As Workbook, ws As Worksheets
Set wb = Workbooks.Open(myPath & myFile) 'ouvre le fichier
Dim WS_Count As Integer ' variable nombre de feuilles '
WS_Count = ActiveWorkbook.Worksheets.Count ' la variable est egale au nombre de feuille compter dans le classeur
For I = 1 To WS_Count ' De la premiere feuille a la derniere feuille compter
With ActiveWorkbook.Worksheets(I) ' avec la feuille active
Select Case True
Case .Name = "EX 141", .Name = "EX", LCase(.Name) Like "feui*"
GoTo suite
Case Else
If .Range(.Cells(LiC, CoC), .Cells(LiC, CoC)) = "9" Then ' si il vois la position 9 sans rien d autre
If WorksheetFunction.CountBlank(.Range(.Cells(LiC + 2, CoC), .Cells(LiC + 3, CoC))) <> 2 Or WorksheetFunction.CountBlank(.Range(.Cells(LiC + 5, CoC), .Cells(LiC + 5, CoC))) <> 1 Then
ElseIf .Range(.Cells(LiC + 1, CoC), .Cells(LiC + 1, CoC)) = "0" Then
ElseIf .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "F" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "FOR" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MAD" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MADOM" = 1 Or UCase(Left(.Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)), 2)) = "RT" Then
Else
compteur9 = compteur9 + 1
com9 = com9 + .Name & " / "
End If
End If
If .Range(.Cells(LiC, CoC), .Cells(LiC, CoC)) = "9/6" Then
compteur6 = compteur6 + 1
com6 = com6 + .Name & " / "
End If
If .Range(.Cells(LiC, CoC), .Cells(LiC, CoC)) = "6" Then
If WorksheetFunction.CountBlank(.Range(.Cells(LiC + 2, CoC), .Cells(LiC + 3, CoC))) <> 2 Or WorksheetFunction.CountBlank(.Range(.Cells(LiC + 5, CoC), .Cells(LiC + 5, CoC))) <> 1 Then
ElseIf .Range(.Cells(LiC + 1, CoC), .Cells(LiC + 1, CoC)) = "0" Then
ElseIf .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "F" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "FOR" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MAD" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MADOM" = 1 Or UCase(Left(.Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)), 2)) = "RT" Then
Else
compteur6 = compteur6 + 1
com6 = com6 + .Name & " / "
' MsgBox ActiveWorkbook.Worksheets(I).Name
End If
End If
If .Range(.Cells(LiC, CoC), .Cells(LiC, CoC)) = "5" Then
If WorksheetFunction.CountBlank(.Range(.Cells(LiC + 2, CoC), .Cells(LiC + 3, CoC))) <> 2 Or WorksheetFunction.CountBlank(.Range(.Cells(LiC + 5, CoC), .Cells(LiC + 5, CoC))) <> 1 Then
ElseIf .Range(.Cells(LiC + 1, CoC), .Cells(LiC + 1, CoC)) = "0" Then
ElseIf .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "F" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "FOR" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MAD" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MADOM" = 1 Or UCase(Left(.Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)), 2)) = "RT" Then
Else
compteur6 = compteur6 + 1
com6 = com6 + .Name & " / "
'MsgBox ActiveWorkbook.Worksheets(I).Name
End If
End If
If .Range(.Cells(LiC, CoC), .Cells(LiC, CoC)) = "5/9" Then
compteur9 = compteur9 + 1
com9 = com9 + .Name & " / "
End If
End Select
End With
suite:
Next I
myFile = Dir()
Loop
Range(Cells(LiP6, mois6), Cells(LiP6, mois6)) = compteur6
Range(Cells(LiP6, mois6), Cells(LiP9, mois6)).ClearComments
Range(Cells(LiP6, mois6), Cells(LiP9, mois6)).AddComment
Range(Cells(LiP6, mois6), Cells(LiP9, mois6)).Comment.Visible = False
Range(Cells(LiP6, mois6), Cells(LiP9, mois6)).Comment.Text Text:="Agents Presents:" & Chr(10) & com6
Range(Cells(LiP9, mois9), Cells(LiP9, mois9)) = compteur9
Range(Cells(LiP9, mois9), Cells(LiP9, mois9)).ClearComments
Range(Cells(LiP9, mois9), Cells(LiP9, mois9)).AddComment
Range(Cells(LiP9, mois9), Cells(LiP9, mois9)).Comment.Visible = False
Range(Cells(LiP9, mois9), Cells(LiP9, mois9)).Comment.Text Text:="Agents Presents:" & Chr(10) & com9
com6 = ""
com9 = ""
LiP6 = LiP6 + 1
LiP9 = LiP9 + 1
compteur9 = 0
compteur6 = 0
Next CoC
LiP9 = 5
LiP6 = 5
LiC = LiC + 9
mois6 = mois6 + 3
mois9 = mois9 + 3
Next L
Call fermer
End Sub
Sub JuiltoDec()
LiP9 = 38
LiP6 = 38
LiC = 62
mois6 = 2
mois9 = 3
Dim myPath As String, myFile As Variant 'Declaration de variable pour ouvrir fichier
For L = 1 To 6
For CoC = 3 To 33
myPath = ThisWorkbook.Path & "\" 'mon chemin
myFile = Dir(myPath & "\Groupe*.xls*") 'mon fichier (commence par groupe)
Do While myFile <> "" 'tant qu'il y a des fichier
Dim wb As Workbook, ws As Worksheets
Set wb = Workbooks.Open(myPath & myFile) 'ouvre le fichier
Dim WS_Count As Integer ' variable nombre de feuilles '
WS_Count = ActiveWorkbook.Worksheets.Count ' la variable est egale au nombre de feuille compter dans le classeur
For I = 1 To WS_Count ' De la premiere feuille a la derniere feuille compter
With ActiveWorkbook.Worksheets(I) ' avec la feuille active
Select Case True
Case .Name = "EX 141", .Name = "EX", LCase(.Name) Like "feui*"
GoTo suite
Case Else
If .Range(.Cells(LiC, CoC), .Cells(LiC, CoC)) = "9" Then ' si il vois la position 9 sans rien d autre
If WorksheetFunction.CountBlank(.Range(.Cells(LiC + 2, CoC), .Cells(LiC + 3, CoC))) <> 2 Or WorksheetFunction.CountBlank(.Range(.Cells(LiC + 5, CoC), .Cells(LiC + 5, CoC))) <> 1 Then
ElseIf .Range(.Cells(LiC + 1, CoC), .Cells(LiC + 1, CoC)) = "0" Then
ElseIf .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "F" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "FOR" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MAD" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MADOM" = 1 Or UCase(Left(.Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)), 2)) = "RT" Then
Else
compteur9 = compteur9 + 1
com9 = com9 + .Name & " / "
End If
End If
If .Range(.Cells(LiC, CoC), .Cells(LiC, CoC)) = "9/6" Then
compteur6 = compteur6 + 1
com6 = com6 + .Name & " / "
End If
If .Range(.Cells(LiC, CoC), .Cells(LiC, CoC)) = "6" Then
If WorksheetFunction.CountBlank(.Range(.Cells(LiC + 2, CoC), .Cells(LiC + 3, CoC))) <> 2 Or WorksheetFunction.CountBlank(.Range(.Cells(LiC + 5, CoC), .Cells(LiC + 5, CoC))) <> 1 Then
ElseIf .Range(.Cells(LiC + 1, CoC), .Cells(LiC + 1, CoC)) = "0" Then
ElseIf .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "F" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "FOR" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MAD" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MADOM" = 1 Or UCase(Left(.Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)), 2)) = "RT" Then
Else
compteur6 = compteur6 + 1
com6 = com6 + .Name & " / "
End If
End If
If .Range(.Cells(LiC, CoC), .Cells(LiC, CoC)) = "5" Then
If WorksheetFunction.CountBlank(.Range(.Cells(LiC + 2, CoC), .Cells(LiC + 3, CoC))) <> 2 Or WorksheetFunction.CountBlank(.Range(.Cells(LiC + 5, CoC), .Cells(LiC + 5, CoC))) <> 1 Then
ElseIf .Range(.Cells(LiC + 1, CoC), .Cells(LiC + 1, CoC)) = "0" Then
ElseIf .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "F" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "FOR" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MAD" Or .Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)) = "MADOM" = 1 Or UCase(Left(.Range(.Cells(LiC + 4, CoC), .Cells(LiC + 4, CoC)), 2)) = "RT" Then
Else
compteur6 = compteur6 + 1
com6 = com6 + .Name & " / "
End If
End If
If .Range(.Cells(LiC, CoC), .Cells(LiC, CoC)) = "5/9" Then
compteur9 = compteur9 + 1
com9 = com9 + .Name & " / "
End If
End Select
End With
suite:
Next I
myFile = Dir()
Loop
Range(Cells(LiP6, mois6), Cells(LiP6, mois6)) = compteur6
Range(Cells(LiP6, mois6), Cells(LiP9, mois6)).ClearComments
Range(Cells(LiP6, mois6), Cells(LiP9, mois6)).AddComment
Range(Cells(LiP6, mois6), Cells(LiP9, mois6)).Comment.Visible = False
Range(Cells(LiP6, mois6), Cells(LiP9, mois6)).Comment.Text Text:="Agents Presents:" & Chr(10) & com6
Range(Cells(LiP9, mois9), Cells(LiP9, mois9)) = compteur9
Range(Cells(LiP9, mois9), Cells(LiP9, mois9)).ClearComments
Range(Cells(LiP9, mois9), Cells(LiP9, mois9)).AddComment
Range(Cells(LiP9, mois9), Cells(LiP9, mois9)).Comment.Visible = False
Range(Cells(LiP9, mois9), Cells(LiP9, mois9)).Comment.Text Text:="Agents Presents:" & Chr(10) & com9
com6 = ""
com9 = ""
LiP6 = LiP6 + 1
LiP9 = LiP9 + 1
compteur9 = 0
compteur6 = 0
Next CoC
LiP9 = 38
LiP6 = 38
LiC = LiC + 9
mois6 = mois6 + 3
mois9 = mois9 + 3
Next L
Call fermer
End Sub
Private Sub CommandButton1_Click()
Call JanviertoJuin
End Sub
Private Sub CommandButton2_Click()
Call JuiltoDec
End Sub
Private Sub CommandButton3_Click()
Call JanviertoJuin
Call JuiltoDec
End Sub
Private Sub CommandButton4_Click()
Select Case True
Case Range("T14") = "Janvier", Range("T14") = "Février", Range("T14") = "Mars", Range("T14") = "Avril", Range("T14") = "Mai", Range("T14") = "Juin"
If Range("T14").Value = "Janvier" Then
mois = 8
neuf = 3
six = 2
ElseIf Range("T14") = "Février" Then
mois = 17
neuf = 6
six = 5
ElseIf Range("T14") = "Mars" Then
mois = 26
neuf = 9
six = 8
ElseIf Range("T14") = "Avril" Then
mois = 35
neuf = 12
six = 11
ElseIf Range("T14") = "Mai" Then
mois = 44
neuf = 15
six = 14
ElseIf Range("T14") = "Juin" Then
mois = 53
neuf = 18
six = 17
End If
Call Modif6premiermois
Case Range("T14") = "Juillet", Range("T14") = "Août", Range("T14") = "Septembre", Range("T14") = "Octobre", Range("T14") = "Novembre", Range("T14") = "Décembre"
If Range("T14").Value = "Juillet" Then
mois = 62
neuf = 3
six = 2
ElseIf Range("T14") = "Août" Then
mois = 71
neuf = 6
six = 5
ElseIf Range("T14") = "Septembre" Then
mois = 80
neuf = 9
six = 8
ElseIf Range("T14") = "Octobre" Then
mois = 89
neuf = 12
six = 11
ElseIf Range("T14") = "Novembre" Then
mois = 98
neuf = 15
six = 14
ElseIf Range("T14") = "Décembre" Then
mois = 107
neuf = 18
six = 17
End If
Call Modif6derniersmois
End Select
'Call Modif6derniersmois
End Subsa fonctionne parfaitement il reste plus qu'a optimiser !