在兩列的基礎上找到最大連續重復值

我是新手，需要 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

電流輸出（不包括序列號）

uj5u.com熱心網友回復：

截圖/

匯總表本身應包含多行（取決于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 - 運行宏

如果您希望下載基礎作業簿，請注意 (?) 保存為無宏作業簿以確保您自己的安全 - 否則與此建議解決方案中的螢屏截圖相同。

uj5u.com熱心網友回復：

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

標籤：

上一篇：為什么我的下拉串列宏有時只能作業？

下一篇：根據另一列計算最大值并用連接寫下來