合并行，总和一列值，并保持最早的开始时间和最后的结束时间 [英] Merge rows, sum one column of values, and keep earliest start time and latest end time

问题描述

我已经能够找到将合并行并删除不再需要的重复行并且总计其中一列的代码。然而，这些代码是基于ActiveCells，这对我来说不起作用。我需要这样做来处理大量的数据。如下面的示例中，将包含需要合并的行，2行或更多行。但是我还有一个额外的要求，我只是找不到解决方案。以下是我们可以使用的一小部分数据。这里有4列（实际数据集中还有5列，但它们都是重复数据，而不是本示例所需），这代表了挑战。我需要将这三行合并成一行，在列B中添加值（下面继续）

I have been able to find code that will merge rows and delete the duplicate rows that are not needed any more and sum one of the columns. However, those codes are based on ActiveCells, which will not work for me. I need this to work on a large range of data. As in the example below, there will be rows of 2, 3, or more rows that need to be merged. But I also have an additional requirement that I just cannot find a solution for. Below is a small set of data that we can use as an example. There are 4 columns here (there are 5 more columns in the actual data set, but they are all duplicate data and not needed for this example) that represents the challenge. I would need to merge these three rows into one, add the values in column B (continued below)

最终结果将是最早的开始日期&保存时间和最新的开始日期&时间也被保留：

The final result would be this where the earliest Start date & time is kept and the latest start date & time are also kept:

数据将以列A到Z（行1是标题列），并且每小时添加数据。对于所有其他代码，我通常将行数限制为2000.我们还没有超过。我有一个自定义菜单，我将用于触发代码，目的是尽可能少的用户输入（自动化是关键）。有没有办法使用VBA？

The data will be in columns A through Z (row 1 is a header column), and data is added hourly. For all my other code, I typically limit the number of rows to 2000. We have not exceeded that yet. I have a custom menu that I will use to trigger the code as the purpose is to have as little user input as possible (automation is key). Is there a way to do this with VBA?

推荐答案

如果列 A 被排序，然后尝试这个代码：

If column A is sorted then try this code:

Sub Test()

  Dim Rng As Range, dRng As Range
  Dim i As Long, LR As Long 'lastrow

    With Application
     .ScreenUpdating = False
     .EnableEvents = False
     .Calculation = xlCalculationManual
    End With

    LR = Range("A" & Rows.Count).End(xlUp).Row
    Set Rng = Range("A2:D2")

    For i = 3 To LR
     If Rng(1) = Cells(i, 1) Then          
      Set Rng = Range(Rng(1), Cells(i, 4))
     Else
      If Rng.Rows.Count > 1 Then GoSub mSub
      Set Rng = Range(Cells(i, 1), Cells(i, 4))
     End If
    Next

    If Rng.Rows.Count > 1 Then GoSub mSub
    If Not dRng Is Nothing Then dRng.EntireRow.Delete

    With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
    End With

  Exit Sub

mSub:

    With WorksheetFunction
     Rng(2) = .Sum(Rng.Columns(2))
     Rng(3) = .Min(Rng.Columns(3))
     Rng(4) = .Max(Rng.Columns(4))
    End With

    If dRng Is Nothing Then
     Set dRng = Range(Rng(2, 1), Rng(Rng.Count))
    Else
     Set dRng = Union(dRng, Range(Rng(2, 1), Rng(Rng.Count)))
    End If

  Return
End Sub

这篇关于合并行，总和一列值，并保持最早的开始时间和最后的结束时间的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！