☰

如何使用宏查找列上的最新日期/时间

tag-icon • tag-icon microsoft-excel macros
如何使用宏查找列上的最新日期/时间

我有系统生成的数据，如下表所示。在最后一列，我需要显示每个部门中最后一个更新系统的用户。

Update Time     User    Department  Last update  
-------------------------------------------------------
1/19/12 7:26    John    A
1/19/12 6:26    Yen     A
1/18/12 9:47    Jefta   B
1/18/12 9:47    Jefta   B
1/18/12 9:47    John    A

答案1

如果我明白您的问题，并且这是在 Excel 中，那么您可以使用“数组公式”。

例如，如果您的数据集位于 A1:C5 范围内的工作表中，则可以在“D”列中使用它：

{=INDIRECT("B" & MATCH(MAX(IF(C$1:C$5=C1,(A$1:A$5),)),A$1:A$5,0))}

此公式将通过返回找到最大日期的行的行号来动态构建指向所需用户名的单元格引用，但仅限于部门值与“C”列（部门列）中该行的值匹配的行，并将其附加到文本字符“B”（包含用户名的列），从而创建整个“字母+数字”单元格引用。

请注意，这需要是一个数组函数，这意味着在输入公式后离开单元格时必须按住Ctrl+ Shift+，Enter而不是像平常一样直接输入。如果操作正确，公式将被括在花括号中，如上所示。如果没有花括号括住公式，则它未设置为数组公式，并且无法正常工作。

可能有更简单或更优雅的方法来做到这一点，但如果您只是需要一个快速而粗糙的解决方案，那么这将起作用。

如果您需要更多解释，我可以提供更多细节。

答案2

回来后发现还没有人发布 VBA 解决方案。我想我应该发布一个。

'indexes of the values stored as an array in the collection object
  Private Const USERNAME As Integer = 0
  Private Const DATETIME As Integer = 1



'references to where the data is or should be in the workbook
Public Enum DataColumns
    DateTimeStamp = 1
    UName = 2
    Department = 3
    LastUpdater = 4     'The information we will be adding!
End Enum



Sub Main()
    Dim lastUserByDept As Collection
    Set lastUserByDept = GetLastUpdater(2)
    AppendLastUserName 2, lastUserByDept
End Sub



'//Builds a collection of department entries, and stores
'//the last date along with the user tied to that date
Private Function GetLastUpdater(dataStartRow As Long) As Collection
    Dim currRow As Integer: currRow = dataStartRow



Dim maxDatesByDept As Collection
Set maxDatesByDept = New Collection

Dim deptInfo As Variant
Do While Not IsEmpty(Cells(currRow, DataColumns.DateTimeStamp))
    Dim dept As String: dept = Cells(currRow, DataColumns.Department).Value
    If DeptExists(maxDatesByDept, dept) Then
        If Cells(currRow, DataColumns.DateTimeStamp).Value > maxDatesByDept.Item(dept)(DATETIME) Then
            deptInfo = Array(Cells(currRow, DataColumns.UName).Value, Cells(currRow, DataColumns.DateTimeStamp).Value)
            UpdateExistingEntry maxDatesByDept, deptInfo, Cells(currRow, DataColumns.Department)
        End If
    Else
        deptInfo = Array(Cells(currRow, DataColumns.UName).Value, Cells(currRow, DataColumns.DateTimeStamp).Value)
        maxDatesByDept.Add deptInfo, Cells(currRow, DataColumns.Department).Value
    End If

    currRow = currRow + 1
Loop

Set GetLastUpdater = maxDatesByDept
Set maxDatesByDept = Nothing




End Function



'//Since we are using the VBA collection object, there is no true
'//test for if an element exists; the collection will just throw
'//an error if you ask it for something it cannot find, so just
'//trap the error and return false in that case, as it means no
'//item was found in the list with that dept as it's key
Private Function DeptExists(ByRef deptList As Collection, dept As String) As Boolean
    On Error GoTo handler
    deptList.Item dept
    DeptExists = True
    Exit Function
handler:
    Err.Clear
    DeptExists = False
End Function



'//Updates an existing entry in our collection of dept users.
'//Note: this implementation allows for the trapping of failed attempts
'//but is not used in this version to keep it as straight-forward as
'//possible - If it was important to know when such attempts failed, you
'//could trap on the return value of this method and take the appropriate
'//action.
Private Function UpdateExistingEntry(ByRef deptList As Collection, ByVal deptInfo As Variant, ByVal dept As String) As Boolean
    On Error GoTo handler



If DeptExists(deptList, dept) Then
    deptList.Remove dept
    deptList.Add deptInfo, dept
    UpdateExistingEntry = True
Else
    UpdateExistingEntry = False
End If
Exit Function




handler:
    Err.Clear
    UpdateExistingEntry = False
End Function



'//Uses the created collection of dept, username to add the
'//required username to the column
Private Sub AppendLastUserName(dataStartRow As Long, deptListing As Collection)
    Dim currRow As Integer: currRow = dataStartRow
    Do While Not IsEmpty(Cells(currRow, DataColumns.DateTimeStamp))
        Dim currDept As String: currDept = Cells(currRow, DataColumns.Department)
        Cells(currRow, DataColumns.LastUpdater).Value = deptListing(currDept)(USERNAME)
        currRow = currRow + 1
    Loop
End Sub

此代码将把最后一个更新系统的人的用户名放在部门范围内。

请注意，它假设了一些事情，例如列位置；有一个枚举用于引用相关列，因此如果它们与示例不同，您可以将它们指向正确的列索引，并且所有都应该按预期工作。它还假设包含日期戳的列没有间隙，并且始终是日期。

将整套代码复制并粘贴到 Excel 中的单个模块中，它就可以正常工作。

相关内容