Excel - 使用 VBA 根据今天的日期跳转到特定列答案

【问题标题】：Excel - jump to a specific column according to today's date using VBAExcel - 使用 VBA 根据今天的日期跳转到特定列
【发布时间】：2017-05-24 00:11:38
【问题描述】：

我尝试将光标调整到 Excel 工作表的匹配日期列。在我看来，所有“查找”或“匹配”功能都无法正常工作。

我正在使用 Excel 2007。

日期值在 R10:HU10 的范围内，格式如下：DD.MM.YYYY，格式化用户定义（也尝试过日期和文本 - 没有区别）。今天的日期在单元格 (CI10) 中。

工作表窗口冻结在“Q”列 - 日期条目开始之前的最后一列。

我试图完成的是向右滚动，因此“CI10”列将位于“Q”列旁边

出于测试原因，我尝试使用以下 VBA 代码为特定列着色：

Private Sub Worksheet_Activate()

  Dim TodaysDate As Date
  Dim Rng As Range

  TodaysDate = Date
  With Rows("10:10")
  Set Rng = .Find(what:=TodaysDate, _
  after:=.Cells(.Cells.Count), _
  LookIn:=xlFormulas, _
  lookat:=xlWhole, _
  SearchOrder:=xlByColumns, _
  SearchDirection:=xlNext, MatchCase:=False)
  If Not Rng Is Nothing Then
    Rng.EntireColumn.Interior.Color = vbMagenta
  Else
    'Give a message that today's date was not found
    MsgBox "Nothing found"
  End If
  End With
End Sub

它不起作用，因为 Rng 将永远是“无”。

任何帮助将不胜感激，尤其是有关系统日期和搜索范围内日期条目之间正确比较方法的提示

【问题讨论】：

我不太精通日期函数，但对我而言，Date 以m/d/yyyy 的格式返回，这与您的dd.mm.yyyy 不匹配，但这可能是本地化问题。尽管如此，当你运行它时，你真的检查过TodaysDate 是什么吗？我建议您在设置后立即调用一个消息框来查看值，即MsgBox TodaysDate

标签： excel date comparison positioning vba

【解决方案1】：

我这样做了，效果很好。 dateRange 可能类似于“A1:H1”，当前数据输入到单元格 H1，脚本在运行时跳转到单元格 H1。

Sub jumpToDate()
Dim c As Range
Dim d As Date
d = Date
    For Each c In Range("dateRange")
        If c = d Then
            c.Select
        End If
    Next c
End Sub

我想这就是你要找的，只是阅读标题。

我使用的是非英语/excel 日期格式 (dd/mm/YYYY)，这通常让我头疼的工作日期格式，但无论如何 excel 都能正确处理日期

【讨论】：

惊人的简单，它的工作原理和我想要的一样。唯一的问题是，所需的列不在 Q 列旁边。目标列位于 Q 列和可见列的右边界之间。
@Nikosap 要使所需单元格位于左上角，请使用Application.GoTo c, True 而不是c.Select。

【解决方案2】：

我建议您在单元格的值中搜索日期，而不是在用于计算单元格的公式中。

因此将您的 LookIn:=xlFormulas 更改为 LookIn:=xlValues。

Private Sub Worksheet_Activate()
    Dim TodaysDate As Date
    Dim Rng As Range

    TodaysDate = Date
    With Rows("10:10")
        Set Rng = .Find(what:=TodaysDate, _
                        after:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        lookat:=xlWhole, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then
            Rng.EntireColumn.Interior.Color = vbMagenta
            'Set the window so that the date is in the top-left corner 
            Application.GoTo Rng, True
        Else
            'Give a message that today's date was not found
            MsgBox "Nothing found"
        End If
    End With
End Sub

【讨论】：

我将 LookIn 更改为 xlValues 但没有区别 - 不知道为什么它不起作用。