Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !
Function NbWseul%(nom As Range)
Application.Volatile
Dim a, F As Worksheet, i, F1 As Worksheet, F2 As Worksheet, lig&, lig1&, lig2&, col%, compte1%, compte%
'---préparation---
a = Array("janvier", "février", "mars", "avril", "mai", "juin", "juillet", "août", "septembre", "octobre", "novembre", "décembre")
Set F = nom.Parent 'feuille en cours
On Error Resume Next
i = Application.Match(F.Name, a, 0)
Set F1 = Sheets(a(i - 2)) 'feuille précédente
Set F2 = Sheets(a(i)) 'feuille suivante
lig = nom.Row
lig1 = Application.Match(nom, F1.[B:B], 0)
lig2 = Application.Match(nom, F2.[B:B], 0)
On Error GoTo 0
'---comptage des W de la feuille précédente---
If Weekday(F.Cells(2, 5), 2) > 1 And lig1 Then
For col = 35 To 5 Step -1
If F1.Cells(lig1, col) = "W" Then compte1 = compte1 + 1
If Weekday(F1.Cells(2, col), 2) = 1 Then Exit For
Next col
End If
'---comptage des W de la feuille en cours---
For col = 5 To 35
If F.Cells(lig, col) = "W" Then compte = compte + 1
If Weekday(F.Cells(2, col), 2) = 7 Then
If compte1 = 0 And compte = 1 Then NbWseul = NbWseul + 1
compte1 = 0
compte = 0
End If
Next col
If lig2 = 0 Then
If compte = 1 Then NbWseul = NbWseul + 1
Exit Function
End If
'---comptage des W de la feuille suivante---
If Weekday(F2.Cells(2, 5), 2) > 1 Then
For col = 5 To 10
If F2.Cells(lig2, col) = "W" Then compte1 = compte1 + 1
If Weekday(F2.Cells(2, col), 2) = 7 Then
If compte = 1 And compte1 = 0 Then NbWseul = NbWseul + 1
Exit For
End If
Next col
End If
End Function
=(AF2+1)*(MOIS(AF2+1)=2)
Donc si je change l'année en 2021, cela fonctionnera toujours parce que la formule reste dans la cellule, même si elle n'affiche pas de valeur?Il ne faut surtout pas de texte vide "" dans cette cellule sinon la fonction NbWseul renvoie une erreur.
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
On Error Resume Next 'si aucune SpecialCell
If IsDate("1/" & Sh.Name) Then Intersect(Sh.[B:B].SpecialCells(xlCellTypeFormulas).EntireRow, Sh.[AK:AK]) = "=NbWseul(RC[-35]:RC[-2])"
End Sub
We use cookies and similar technologies for the following purposes:
Est ce que vous acceptez les cookies et ces technologies?
We use cookies and similar technologies for the following purposes:
Est ce que vous acceptez les cookies et ces technologies?