excel - 使用 SumIfs 查找条件，添加持续时间并在列中重写

Question

我可以使用一些指导。当谈到 VBA 时，我只是一个新手，而且我正在疯狂地编写一个宏。基本上我有一个电子表格

使用 A 到 H 列。我想在 A、E 和 F 列（我用代码调整为日期）中找到匹配项，以求和持续时间。然后我删除重复项。一切正常，除了持续时间始终为 0。

当前代码

     Application.ScreenUpdating = False 'Prevents application from updating screen

    Dim wsTIS As Worksheet: Set wsTIS = ThisWorkbook.Sheets("TimeInStore") 'Initializes 
    varaible for TimeInStore worksheet

    Dim i, j As Integer
    Dim lastRow As Long
    Dim arr

    'Format Date
    lastRow = wsTIS.Range("C" & wsTIS.Rows.Count).End(xlUp).Row  'assign dates to (1-based) 2 dim datafield array
    arr = wsTIS.Range("C5:C" & lastRow + 1).Value2  ' get date values as numbers
      ' rearrange to (0-based) 1-dim array
    arr = Application.Transpose(arr): ReDim Preserve arr(0 To UBound(arr) - 1) ' make it a "flat" (zero-based) array
      ' eliminate time portions and reconvert to date
    For i = 0 To UBound(arr)
       arr(i) = CDate(Fix(arr(i))) ' cut time portions from entire dates
    Next i
     ' Debug.Print Join(arr, "|")
   Range("F5").Resize(UBound(arr), 1).Value2 = Application.Transpose(arr) 'write back array to any wanted column

    'Loops to sort by RBA ID
    wsTIS.Sort.SortFields.Clear 'Clears active sort fields
    wsTIS.Sort.SortFields.Add Key:=Range(wsTIS.Cells(5, 5), wsTIS.Cells(i - 1, 5)) 'Sets key for sort as Device Code
    wsTIS.Sort.SetRange Range(wsTIS.Cells(5, 1), wsTIS.Cells(i - 1, 8)) 'Sets range for sort as all data
    wsTIS.Sort.Apply 'Applies current sort fields

    'Loops to sort by Outlet ID

    j = 5 'Sets initial counter value to 5

    Dim rangeStartRow As Integer 'Initialises variable for start of sort range
    rangeStartRow = 5 'Sets initial value to 5

    Dim rangeEndRow As Integer 'Initialises variable for end of sort range

    Dim activeDC As String 'Initialises variable for active Device Code
    activeDC = wsTIS.Cells(5, 5).Value 'Sets initial Device Code to first in data

    Do While Not IsEmpty(wsTIS.Cells(j, 5)) 'Loops until all visit entries are parsed
    If activeDC <> wsTIS.Cells(j, 5).Value Then 'Executes if current Device Code is not equal to active Device Code
    If j <> 5 Then 'Executes if current visit is not first visit
        rangeEndRow = j - 1 'Sets range end row to previous row
        wsTIS.Sort.SortFields.Clear 'Clears active sort fields
        wsTIS.Sort.SortFields.Add Key:=Range(wsTIS.Cells(rangeStartRow, 1), 
    wsTIS.Cells(rangeEndRow, 1)) 'Sets key for sort as Outlet ID
        wsTIS.Sort.SetRange Range(wsTIS.Cells(rangeStartRow, 1), wsTIS.Cells(rangeEndRow, 8)) 
    'Sets range for sort as all data per Device Code
        wsTIS.Sort.Apply 'Applies current sort fields
    End If
    rangeStartRow = j 'Sets range start row to current row
    activeDC = wsTIS.Cells(j, 5).Value 'Sets active Device Code to current Device Code
    End If
     j = j + 1 'Increments counter value
    Loop

   'Sum time duration for same RBA ID, Date and Store
    Dim MyRange As Range
    Dim k As Integer

    lastRow = wsTIS.Range("G" & wsTIS.Rows.Count).End(xlUp).Row  ' assign time durations to (1-based) 2-dim datafield array
      For k = 5 To lastRow
      Cells(k, 7).Value2 = WorksheetFunction.SumIfs(Range("G:G"), Range("A:A"), "@A", 
      Range("E:E"), "@E", Range("F:F"), "@F")
      Next k

    'Delete Duplicate Rows
    lastRow = wsTIS.Range("A" & Rows.Count).End(xlUp).Row
    Set MyRange = wsTIS.Range("A5:H" & lastRow)
    MyRange.RemoveDuplicates Columns:=Array(1, 5, 6, 7), Header:=xlNo

    Application.ScreenUpdating = True 'Prevents application from updating screen

    End Sub

我已经尝试了我能想到的一切来完成这项工作，请任何输入将不胜感激

标签： excelvbamultiple-columnscriteriasumifs