Recherchez des lignes et des cellules spécifiques dans le calendrier Excel en fonction de la date du jour - excel, excel-vba, vba

Avec zéro chance de trouver une solution sur le Web, je me demandais si quelqu'un ici pourrait m'aider. Vous trouverez ci-dessous un exemple de mon calendrier.

Ci-dessus mon calendrier avec Mois, numéro de semaine etjours au sommet. Tout à gauche, il y a des noms. J'essaie d'obtenir les noms des personnes qui ont F dans la cellule du jour actuel (si le 13 avril était aujourd'hui). Les jours ont le format JJ.MM.AAAA.

Expliqué en détails: Je cherche un code qui trouve la date du jour dans la ligne 3. Lorsque cette date est trouvée, trouvez toutes les cellules de la colonne W qui contient "F". Ensuite, je veux le nom de la personne dans cette rangée.

Et enfin une mauvaise image illustrée de ce que je pense.

La sortie devrait ressembler à quelque chose comme ça. Tous les noms ne doivent pas figurer dans une cellule.

J'espère avoir de l'aide! -J

Réponses:

Si votre ligne 3 a des dates telles que JJ / MM / AAAA mais que vous avez changé le format en Personnalisé et uniquement en DD, les opérations suivantes fonctionneront:

Sub foo()
Dim LastRow As Long
Dim LastCol As Long
Dim NextEmptyRow As Long
Dim SearchDate As String

LastRow = Sheet1.Cells(Sheet1.Rows.Count, "D").End(xlUp).Row
"SearchDate = Format(Now(), "dd/mm/yyyy")
"change the line below with the one above to search for today"s date
SearchDate = "13/04/2017" "find "today"s" date
LastCol = Sheet1.Cells(3, Sheet1.Columns.Count).End(xlToLeft).Column "get the last Column
Sheet2.Cells(1, 1).Value = "Output"
For i = 1 To LastCol "loop through all columns
ValueToFind = Format(Sheet1.Cells(3, i).Value, "dd/mm/yyyy") "format the values on row 3 to full date as dd/mm/yyy
If ValueToFind = SearchDate Then "if date on Row 3 matches SearchDate then
For x = 4 To LastRow "loop through rows
If Sheet1.Cells(x, i).Value = "F" Then "if F exists on that column
NextEmptyRow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1 "check the next free row on Sheet 2 column A
Sheet2.Cells(NextEmptyRow, 1).Value = Sheet1.Cells(x, 4).Value "copy the name to Sheet2 on the next available Row
End If
Next x
End If
Next i
End Sub