Excel 在多列中查找相似值，求和并获取范围

我已经试着解决这个问题一周了，但是找不到正确的方法

如上图所示，我有一个数据列表。列A是组标识符，列B是子组，然后我们在列C中有百分比

我的目标是找到一个：1117，在'TheSameTTitle'中循环，汇总百分比，如果它们超过10%，我将在D列中显示总百分比或一些文本。问题是，我还希望沿“汇总块”合并相应的行。在1117的情况下：相同的标题I将合并D列中的3行。此“合并”用于报告目的

到目前为止，我可以找到1117:theSameTitle并对其求和，但不知道如何检测合并它们所涉及的行。下面是我想到的代码：

Sub determinePercentages()

     ' Select cell A1, *first line of data*.
      Range("A1").Select
      ' Set Do loop to stop when an empty cell is reached.
      Do Until IsEmpty(ActiveCell)
         ' Insert your code here.

         nextCell = ActiveCell.Offset(1, 0).Value
         'nextCell2 = ActiveCell.Offset(1, 3).Value

         If Range("C" & ActiveCell.Row) > 0.1 Then
            'MsgBox (Range("C" & ActiveCell.Row).Value)
            Range("E" & ActiveCell.Row).Value = "YES"
         End If

         'If ActiveCell & ActiveCell.Offset(0, 3) <> nextCell & nextCell2 Then
           curSumIfs = Application.WorksheetFunction.SumIfs(Range("C:C"), Range("A:A"), ActiveCell.Value, Range("B:B"), ActiveCell.Offset(0, 3).Value)
           If curSumIfs >= 0.1 Then
              ActiveCell.Offset(0, 10).Value = curSumIfs
           End If
         'End If

         ' Step down 1 row from present location.
         ActiveCell.Offset(1, 0).Select
      Loop

End Sub

次确定百分比（）
'选择单元格A1，*第一行数据*。
范围（“A1”）。选择
'将Do循环设置为在到达空单元格时停止。
直到IsEmpty（ActiveCell）为止
'在此处插入您的代码。
nextCell=ActiveCell.Offset（1，0）.Value
'nextCell2=ActiveCell.Offset（1,3）.Value
如果范围（“C”和ActiveCell.Row）大于0.1，则
'MsgBox（范围（“C”&ActiveCell.Row）.Value）
范围（“E”和ActiveCell.Row）。Value=“是”
如果结束
'如果ActiveCell&ActiveCell.Offset（0,3）nextCell&nextCell2，则
curSumIfs=Application.WorksheetFunction.SumIfs（范围（“C:C”）、范围（“A:A”）、ActiveCell.Value、范围（“B:B”）、ActiveCell.Offset（0,3）.Value）
如果curSumIfs>=0.1，则
ActiveCell.Offset（0,10）.Value=curSumIfs
如果结束
"完"
'从当前位置下一行。
ActiveCell.Offset（1，0）。选择
环
端接头

我对VBA和Excel也相当陌生。我不知道我的代码有多高效。也许有更好的方法来实现它

我需要您的帮助：）

一种方法是边走边“合并”，将当前行（A列和B列）与前一行进行比较，如果相同，则将当前行与D列中的前一行合并

仅演示合并的代码（我让您合并“是”和“Sumifs”）

---

代码中有几个未声明的变量。一种方法是在执行过程中“合并”，将当前行（a列和B列）与前一行进行比较，如果相同，则将当前行与D列中的前一行合并。关于当前实现，请参阅并尽量避免使用

ActiveCell

。

Sub DeterminePercentages()
    Dim ws As Worksheet
    Set ws = ActiveSheet

    With ws
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

        Dim i As Long
        For i = 2 To lastRow
            If .Cells(i, 1).Value = .Cells(i - 1, 1).Value Then
                If .Cells(i, 2).Value = .Cells(i - 1, 2).Value Then
                    .Range(.Cells(i, 4), .Cells(i - 1, 4).MergeArea).Merge
                End If
            End If
        Next
    End With
End Sub