根据当前日期在Excel日历中查找特定的行和单元格

时间:2017-12-19 13:47:56

标签: excel excel-vba vba

如果没有运气在网络上找到解决方案,我想知道这里是否有人可以帮助我。以下是我的日历示例。 Calendar

以上是我的日历,包括月份,周数和最高日期。在最左边有名字。我想知道当天有单身格F的人的名字(如果4月13日是今天)。日期有DD.MM.YYYY格式。

详细解释: 我正在寻找一个代码,在第3行找到今天的日期。当找到该日期时,找到W列中包含" F"的所有单元格。然后我想要那一行中的人的名字。

最后是一个糟糕的插图图像,我在想什么。 enter image description here

输出应该看起来像这样。所有名称不应列在一个单元格中。 output

希望得到一些帮助! -J

1 个答案:

答案 0 :(得分:0)

如果您的第3行的日期类似于DD / MM / YYYY,但您将格式更改为自定义且仅包含DD,则以下内容将起作用:

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