☰

如何使用巨集查找列上的最新日期/時間

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 中的單一模組中，它將正常運作。

相關內容