☰

マクロを使用して列の最新の日付/時刻を見つける方法

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 の 1 つのモジュールに貼り付けると、問題なく動作します。

関連情報