如何使用VBA注冊產品在設施中停留的時間

以最基本的方式，我需要知道產品在設施中停留的時間。

給它一點背景資訊，這是一個國際機場的主要地勤人員，他們想知道這個問題的答案。因為我正在實習，所以由我來弄清楚。但是我真的可以使用一些幫助。

對于資料集的一個例子，我有它看起來類似于這個 VVV

請參閱下文了解我到目前為止混合和匹配的代碼。

Sub MultipleSearch()

Sheet9.Activate

Dim ULD As String:
Dim ULD_Procedure As Variant
Dim i As Long
Dim rgSearch As Range
Dim ILastCol As Long
Dim cell As Range
Dim CollumnResult As Variant
Dim Result As Variant
Dim DateFlight As Variant


With Sheet9

    LastRow = WorksheetFunction.CountA(Range("B:B"))
            
    For i = 1 To LastRow
        
        ULD = Cells(i, 2).Value

        Sheet3.Activate
       
       ' Get search range
        
        Set rgSearch = Range("I:I")
        Set cell = rgSearch.Find(ULD)
    
        ' Store first cell address
        Dim firstCellAddress As Variant
        firstCellAddress = cell.Address

                ' Find all cells containing set ULD number
                Do
                Sheet9.Activate
                            
                    ILastCol = (1   Cells(i, Columns.Count).End(xlToLeft).Column)
                                              
                'Adjust CellAdres to only give me the correct Row number
                            
                    RowResult = cell.Address
                            
                    Result = Replace(RowResult, "$I$", "")
                            
                    Sheet3.Activate
                            
                    DateFlight = Cells(Result, 4).Value
                            
                    Sheet9.Activate
                            
                    Cells(i, ILastCol).Value = DateFlight
                            
                    Set cell = rgSearch.FindNext(cell)
                        
                Loop While firstCellAddress <> cell.Address
    
    Next i

        If cell Is Nothing Then
            Debug.Print "Not found"
        End If

End With

End Sub

This code miraculously works sort of. I get the dates the ULDs enter the system or left, and with the use of "basic" Excel formulas i can measure the time between ULDs. However not in the correct order, this is due to that not all ULDs enter the system in Inbound. Some are already here and the first record of those ULDs is outbound. Also some ULD miss registration on outbound or inbound. So saying they follow a standard order of inbound outbound inbound outbound is incorrect.

The solution I am looking at is pasting the date focused on inbound and outbound. How I want the result sheet to look like v v

How it currently looks v v v

I currently have no idea how to solve this problem. Furthermore, I'm certainly not asking you to write out my entire code and pass on the solution pre-made. But if you can make an outline of a possible formula / piece of code that I can use will help me tremendously!

If it's hopeless you can say it too.

[@Peh solution not working, but maybe im braindead]

它會向您顯示Inbound航班每停留多少天，直到它Outbound。如果沒有Outbound，則將其標記為no outbound。

因此，您只能計算航班的停留時間，如果它有一個Inbound，Outbound如果缺少其中之一，則無法計算。

要對該時間進行統計，您可以使用AVERAGEIF例如獲取航班的平均停留時間之類的函式。

根據評論編輯：你說：

1, 2, 3, 4 12號到達，但在14號ULD；1、3、5、6 點出發。ULD；2, 4 可能要到很晚之后才能離開設施，例如 30 號。現在 ULD 停機；1, 3 = 2 天，但是ULD；2、4有18天下來。

所以這看起來像

排序（按數字、日期和方向）并使用上述公式后，我得到：

uj5u.com熱心網友回復：

按日期/時間對資料進行排序，并使用 ULD 數字作為鍵和一組日期/時間作為值構建字典。根據行進方向回圈將日期/時間寫入偶數或奇數列的集合。作業表上的資料 (1)，作業表上的報告 (2)。

Sub MultipleSearch2()

    Dim wb As Workbook, ws As Worksheet, wsOut As Worksheet
    Dim rng As Range, r As Long, c As Long, n As Long
    Dim lastrow As Long, lastcol As Long
   
    Dim dict As Object, key, entry
    Set dict = CreateObject("Scripting.Dictionary")

    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)  ' data
    Set wsOut = wb.Sheets(2)  ' output
    lastrow = ws.Cells(Rows.Count, "B").End(xlUp).Row
    lastcol = ws.Cells(1, Columns.Count).End(xlToLeft).Column

    Set rng = ws.Cells(1, 1).Resize(lastrow, lastcol)
    Debug.Print rng.Address
    
   ' sort sheet by date/time
    With ws.Sort
        .SortFields.Clear
        .SortFields.Add key:=ws.Range("D1"), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange rng
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' get list of uids (colI) build collection inbound/outbord
    Dim ID As String, dt As String, inout As String
    For r = 2 To lastrow
        ID = ws.Cells(r, "I")
        If Not dict.exists(ID) Then
            dict.Add ID, New Collection
        End If
        ' add to collection
        dt = Format(ws.Cells(r, "D"), "yyyy-mm-dd hh:mm:ss")
        inout = Left(ws.Cells(r, "P"), 1) ' I or O
        dict(ID).Add inout & "_" & dt, CStr(r)
    Next

    ' output results
    r = 2
    With wsOut
        .Cells.Clear
        .Range("A1:B1") = Array("ULD Number", "First Entry")
        .Rows(1).Font.Bold = True
        For Each key In dict.keys
            ID = CStr(key)
            .Cells(r, 1) = ID
            c = 3
            n = 0
            For Each entry In dict(ID)
                ' inbound odd, outbound even
                If Left(entry, 1) = "O" Then
                    If c Mod 2 = 1 Then c = c   1
                    ' extend header
                    If .Cells(1, c - 1) = "" Then
                        .Cells(1, c - 1) = "Inbound"
                        .Cells(1, c) = "Outbound"
                    End If
                Else
                    If c Mod 2 = 0 Then c = c   1
                        If .Cells(1, c) = "" Then
                            .Cells(1, c) = "Inbound"
                            .Cells(1, c   1) = "Outbound"
                        End If
                End If
                wsOut.Cells(r, c) = Split(entry, "_")(1) ' remove I_
                ' first entry
                n = n   1
                If n = 1 Then .Cells(r, 2) = .Cells(1, c)
                c = c   1
            Next
            r = r   1
        Next
    End With
    MsgBox "Done"
End Sub

標籤：excel vba

上一篇：VlookupwithMatch和NotMatch在VBA中回傳特定值。請找到以下代碼。我需要知道如何獲得匹配值

下一篇：如何在powerpoint中制作帶有2級標題的條形圖？