在两列的基础上找到最大连续重复值

Question

我是新手，需要 VBA 方面的专家帮助。实际上，我正在寻找基于按钮单击事件的两列（序列号和警报代码）的连续计数的 Vba 代码。列行不固定（动态变化）。连续计数是每个序列号的警报代码的最大重复计数。这应该根据每个序列号的最大重复警报计数显示在输出工作表中

输入工作表：

预期输出：

输入表中的重复计数如下模式（仅供参考）。

我的源代码如下，但这不引用第一列序列号（这只适用于像 AlertCode 这样的一列）：

Sub ConsecutiveCount()
      Dim lr As Long, c As Range, a As Long
    Application.ScreenUpdating = False
    lr = Worksheets("Count2").Cells(Rows.Count, 1).End(xlUp).Row
    For Each c In Range("B2:B" & lr)
        If c.Value <> c.Offset(1).Value Then
            a = Cells(c.Row, 3).End(xlUp).Row
'            Range(Cells(c.Row, 4), Cells(c.Row, 4).End(xlUp).Offset(1)).Value = c.Row - a
            Cells(c.Row, 3).Value = c.Row - a
        Else
        End If
    Next c
    Application.ScreenUpdating = True
End Sub

电流输出（不包括序列号）

Answer 1

屏幕截图/here(♪) 指：

---

命名范围/设置

首先，定义几个命名范围以帮助在 VBA 中引用/公式化：

名称：range_data：引用感兴趣的两列的动态范围（此处为 Sheet1 中的第 1 列和第 2 列）：

参考：=Sheet1!$D$3:OFFSET(Sheet1!$E$3,COUNTA(Sheet1!$E$3:$E$99995)-1,0,1,1)

名称：range_summary_startcell：引用输出表/摘要的所需左上角单元格的静态范围。

参考：=Sheet1!$G$3

汇总表本身应包含多行（取决于 range_data）和 3 列（给定输入/Q） - 这将由宏生成（代码如下）并且可以在上面的屏幕截图中看到 (G3:I5) - 宏功能应自动确定适当的尺寸

---

代码

定义这两个命名范围（即 'range_data' 和 'range_summary_startcell'）后，以下 VB 代码会根据您的 Q 生成所需的输出：

Sub Macro_Summary()
'
'JB_007 07/01/2022
'

'
    Application.ScreenUpdating = True
    Range("range_summary_startcell").Select
    ActiveCell.Formula2R1C1 = "=UNIQUE(range_data)"
    ActiveSheet.Calculate
    x = ActiveCell.End(xlDown).Row

    
    Set range_count = ActiveCell.Offset(0, 2)
    range_count.Select
    range_count.Formula2R1C1 = _
        "=COUNTIFS(INDEX(range_data,0,2),RC[-1],INDEX(range_data,0,1),RC[-2])"

    
    Selection.AutoFill Destination:=Range(range_count, range_count.Offset(x - range_count.Row))
    ActiveSheet.Calculate
End Sub

---

注意事项：假设您拥有与 Office 365 兼容的 Excel 版本

---

GIF - 运行宏

---

如果您希望下载基础工作簿，则将注释 (♪) 保存为无宏工作簿以确保您自己的安全 - 否则与此建议解决方案中的屏幕截图相同。

Answer 2

Sub ConsecutiveCount()

    Dim srcLastRow As Long, cntConsec As Long, i As Long
    Dim rng As Range
    Dim srcArr() As Variant
    Dim srcSht As Worksheet
    Dim destsht As Worksheet
    Dim destArr() As Variant
    Dim combID As String
    Dim splitID As Variant
    
    Application.ScreenUpdating = False
    
    Set srcSht = Worksheets("Input")
    Set destsht = Worksheets("Output")
    
    With srcSht
        srcLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1     ' include 1 blank line
        srcArr = .Range(.Cells(2, "A"), .Cells(srcLastRow, "B"))
    End With
    
    Dim dict As Object
    Dim dKey As Variant
    Set dict = CreateObject("Scripting.dictionary")
    
    cntConsec = 0
    
    For i = LBound(srcArr) To UBound(srcArr)
        cntConsec = cntConsec + 1
        If i <> UBound(srcArr) Then
            If srcArr(i, 1) <> srcArr(i + 1, 1) Or srcArr(i, 2) <> srcArr(i + 1, 2) Then
                combID = srcArr(i, 1) & "|" & srcArr(i, 2)
                If dict.Exists(combID) Then
                    ' check if sum is more
                    If dict(combID) < cntConsec Then     ' If new max for combination
                         dict(combID) = cntConsec
                    End If
                Else
                    ' add to dictionary
                    dict(combID) = cntConsec
                    
                End If
                    cntConsec = 0
            End If
        End If
    
    Next i
    
    ReDim destArr(1 To dict.Count, 1 To 3)
    i = 0
    For Each dKey In dict.keys
        splitID = Split(dKey, "|")
        i = i + 1
        destArr(i, 1) = splitID(0)
        destArr(i, 2) = splitID(1)
        destArr(i, 3) = dict(dKey)
    Next dKey
   
    destsht.Range("A2").Resize(UBound(destArr), 3).Value = destArr

    Application.ScreenUpdating = True

End Sub