如何反映不覆盖之前的日期戳记日志？

Question

我有一张Excel工作表，用于跟踪招聘状态，其中每一行都是空缺记录，其中一个单元格是一个下拉列表，用于更改该特定空缺的状态。状态是例如（广告，面试，雇用）

我想要做的是，一旦我点击一个状态，在行的末尾（让我们说我的记录的最后一个是列S，所以当我点击广告时，日期戳会继续{{ 1}}状态本身会在列S上打印出来，如果我选择第二个状态，则会显示列T＆amp; U，依此类推。

到目前为止我使用的是不同的东西，它反映了基于该状态的相应列的日期戳：

V

Answer 1

如果我理解正确，你想要在R行周围的每一行下拉，有3个选项，当选择时，将使用当前日期填充右边的单元格1,2或3个单元格。

我要做的是：如果我要在单元格R2上放置一个Drop Down，那么将其调整为与单元格*完全相同（参见本答案的底部）并且隐藏它下方的Cell Link，$R2。

指定一个宏，指向模块中的此子：

Sub DropDown2_Change() '(all the drop downs call this sub, on change)

    Dim dd As Shape, ddCell As String, ddValue As String, ddIndex As Integer
    Set dd = ActiveSheet.Shapes(Application.Caller) 'shape object: the selected DropDown
    ddValue = dd.ControlFormat.List(dd.ControlFormat.ListIndex) 'dropdown's new string value [not used]
    ddCell = dd.ControlFormat.LinkedCell 'range object: the cell linked to the dropdown
    ddIndex = ActiveSheet.Range(ddCell) 'selected index: 1=Advertised,2=Interviewed,3=Hired
    Range(ddCell).Offset(0, ddIndex) = Date 'set date of cell 1,2,or 3 cells to the right

End Sub

• 有时让Drop Downs正确排列细胞可能会很痛苦（特别是如果你之后开始在柱子周围移动），但在过去我发现最好create & setup the Drop Downs programmatically，以确保完美对齐，正确的命名等等（事实上，任何时候我做需要在那之后移动它们，我只是删除并重新创建它们，以避免头痛。）

根据您的需要，您可以手动复制第一个完成的，正常运行的Drop Down，并将其逐个粘贴到下面的每个单元格中。只需确保Cell Link是Abs / Rel，如** $ ** B2，否则它们都可能默认为相同的Cell Link。

如果它们都共享相同的sub，那也没关系，因为上面的代码将检查更改的Drop Down的Cell Link。

通过这种方式，您不必使用WorkSheet_Change（无论如何都不会触发下拉更改）。

您可以下载我在JumpShare中使用的测试表：tmpDropDowns.xlsm。 （它在线查看，但除非您下载，否则VBA将无效。）

如果您有任何疑问，请与我联系！

UPDATE：

使用Date + Status填充Drop Down右侧的第一个空单元格（而不是仅填充S，T，U列）。

更新代码：

选项明确

Sub DropDown2_Change（）'（所有下拉调用此子，在更改时）

Dim dd As Shape, ddCell As String, ddValue As String, ddIndex As Integer
Set dd = ActiveSheet.Shapes(Application.Caller) 'shape object: the selected DropDown
ddValue = dd.ControlFormat.List(dd.ControlFormat.ListIndex) 'dropdown's new string value
ddCell = dd.ControlFormat.LinkedCell 'range object: the cell linked to the dropdown
ddIndex = ActiveSheet.Range(ddCell) 'selected index: 1=Advertised,2=Interviewed,3=Hired [not used]
FirstEmptyCellToRight(Range(ddCell)) = ddValue & " " & Date 'set date of cell 1,2,or 3 cells to the right
End Sub



Function FirstEmptyCellToRight(cell_In As Range) As Range
    'since ".End(xlToRight).Offset(0, 1)" wasn't working for me
    'returns cell_In if it's blank, and if not then the first blank cell to the right
    Set FirstEmptyCellToRight = cell_In
    Do Until IsEmpty(FirstEmptyCellToRight) Or FirstEmptyCellToRight.Value = ""
        Set FirstEmptyCellToRight = FirstEmptyCellToRight.Offset(0, 1)
    Loop
End Function

添加屏幕截图：

JumpShare上的更新文件：tmpDropDowns.xlsm （必须下载;在线查看不适用于VBA。）