luke3300
XLDnaute Impliqué
Bonjour à tous,
Le code ci-dessous me sert à effectuer une synthèse sur des tâches effectuées.
Actuellement, il indique automatiquement un "1" en regard des noms si toutes les tâches anciennes reprises (par colonne) dans les cellules F10 à DA25 sont effectuées.
J'aimerais pouvoir l'améliorer en le faisant ajouter un "2" à partir du moment où 1 seule des tâches par colonne est effectuée.
Par exemple, dans le fichier joint, si Jojo 1 en onglet "New" fait (d'après l'onglet "D") les tâches x03 et x45 qui composent la nouvelle tâche X03, le code n'indiquera rien en cellule H26 parce que Jojo1 ne connaît pas la tâche x32 qui fait partie aussi de la nouvelle X03. J'aimerais qu'il indique alors un "2" pour me permettre de voir qu'une partie du nouveau X03 est faite.
Private Sub CommandButton2_Click()
Dim nom As Integer, tachesNouvelles As Integer, tacheAncienne As Range
Dim colTache As Range, ligneNom As Range, estCapable As Integer
For nom = 26 To 125 'Les nombres sont à modifier suivant la 1ère et la dernière cellule contenant un nom'
For tachesNouvelles = 6 To 106
estCapable = 1
Set tacheAncienne = ThisWorkbook.Sheets("New").Cells(10, tachesNouvelles)
With ThisWorkbook.Sheets("D")
While tacheAncienne.Row < 17
If tacheAncienne.Value <> vbNullString Then
Set colTache = .Rows(9).Find(what:=tacheAncienne.Value, LookIn:=xlValues, lookat:=xlWhole)
Set ligneNom = .Columns(4).Find(what:=ThisWorkbook.Sheets("New").Range("D" & nom).Value, LookIn:=xlValues, lookat:=xlWhole) 'La colonne "4" est la colonne contenant les noms'
If ligneNom Is Nothing Then
estCapable = 0
Else
If Not colTache Is Nothing Then
estCapable = estCapable * IIf(.Cells(ligneNom.Row, colTache.Column).Value = 1, 1, 0)
End If
End If
End If
Set tacheAncienne = tacheAncienne.Offset(1, 0)
Wend
End With
If ThisWorkbook.Sheets("New").Cells(10, tachesNouvelles).Value = vbNullString Then estCapable = 0
ThisWorkbook.Sheets("New").Cells(nom, tachesNouvelles).Value = IIf(estCapable = 1, 1, "")
Next tachesNouvelles
Next nom
End Sub
Je joint le fichier pour plus de détails et excellente journée à tous et toutes.
Le code ci-dessous me sert à effectuer une synthèse sur des tâches effectuées.
Actuellement, il indique automatiquement un "1" en regard des noms si toutes les tâches anciennes reprises (par colonne) dans les cellules F10 à DA25 sont effectuées.
J'aimerais pouvoir l'améliorer en le faisant ajouter un "2" à partir du moment où 1 seule des tâches par colonne est effectuée.
Par exemple, dans le fichier joint, si Jojo 1 en onglet "New" fait (d'après l'onglet "D") les tâches x03 et x45 qui composent la nouvelle tâche X03, le code n'indiquera rien en cellule H26 parce que Jojo1 ne connaît pas la tâche x32 qui fait partie aussi de la nouvelle X03. J'aimerais qu'il indique alors un "2" pour me permettre de voir qu'une partie du nouveau X03 est faite.
Private Sub CommandButton2_Click()
Dim nom As Integer, tachesNouvelles As Integer, tacheAncienne As Range
Dim colTache As Range, ligneNom As Range, estCapable As Integer
For nom = 26 To 125 'Les nombres sont à modifier suivant la 1ère et la dernière cellule contenant un nom'
For tachesNouvelles = 6 To 106
estCapable = 1
Set tacheAncienne = ThisWorkbook.Sheets("New").Cells(10, tachesNouvelles)
With ThisWorkbook.Sheets("D")
While tacheAncienne.Row < 17
If tacheAncienne.Value <> vbNullString Then
Set colTache = .Rows(9).Find(what:=tacheAncienne.Value, LookIn:=xlValues, lookat:=xlWhole)
Set ligneNom = .Columns(4).Find(what:=ThisWorkbook.Sheets("New").Range("D" & nom).Value, LookIn:=xlValues, lookat:=xlWhole) 'La colonne "4" est la colonne contenant les noms'
If ligneNom Is Nothing Then
estCapable = 0
Else
If Not colTache Is Nothing Then
estCapable = estCapable * IIf(.Cells(ligneNom.Row, colTache.Column).Value = 1, 1, 0)
End If
End If
End If
Set tacheAncienne = tacheAncienne.Offset(1, 0)
Wend
End With
If ThisWorkbook.Sheets("New").Cells(10, tachesNouvelles).Value = vbNullString Then estCapable = 0
ThisWorkbook.Sheets("New").Cells(nom, tachesNouvelles).Value = IIf(estCapable = 1, 1, "")
Next tachesNouvelles
Next nom
End Sub
Je joint le fichier pour plus de détails et excellente journée à tous et toutes.