如何计算两列中的匹配项并重置计数器？

Question

这是我之前的数据：

A   Ron
A   Ron
B   Jeremy
C   Jeremy
C   Teddy
C   Teddy
C   Teddy
D   George
D   George

这是我以后想看到的：

A   Ron 2
B   Jeremy  1
C   Jeremy  1
C   Teddy   3
D   George  2

这是我的非工作脚本：

Sub Macro()
i = 1
Dim lngRow As Long
For lngRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
If Range("A" & lngRow) = Range("A" & lngRow - 1) And _
    Range("B" & lngRow) = Range("B" & lngRow - 1) Then
        i = i + 1
        Range("C" & lngRow - 1).Value = i
    Rows(lngRow).Delete
End If
Next
i = 1
End Sub

计数器出了点问题，但我不知道是什么。

Answer 1

您的（第二个）i = 1 放错了位置 - 每次“键”发生变化时，您都需要重置 i：

Sub Macro()
    i = 1
    Dim lngRow As Long
    For lngRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If Range("A" & lngRow) = Range("A" & lngRow - 1) And _
           Range("B" & lngRow) = Range("B" & lngRow - 1) Then
            i = i + 1
            Range("C" & lngRow - 1).Value = i
            Rows(lngRow).Delete
        Else
            i = 1
            'Also need to set the previous "total" here, just in case
            'it is the only record for this "key"
            Range("C" & lngRow - 1).Value = i
        End If
    Next
End Sub

Answer 2

一些 SQL 怎么样：

SELECT F1, F2, COUNT(*)
FROM [SheetName$]
GROUP BY F1, F2

使用 ADO 连接到 Excel 工作表，并使用 CopyFromRecordset 将结果粘贴到新工作表中。

一个类似的例子here，和一些ADO的参考可以在here找到。

Answer 3

你可以使用Dictionary对象：

Sub Main()
    Dim cell As Range, dataRng As Range

    Set dataRng = Range("A1").CurrentRegion
    With CreateObject("Scripting.Dictionary")
        For Each cell In dataRng.Columns(1).Cells
            .Item(Join(Application.Transpose(Application.Transpose(cell.Resize(, 2).Value)), "|")) = .Item(Join(Application.Transpose(Application.Transpose(cell.Resize(, 2).Value)), "|")) + 1
        Next cell
        dataRng.ClearContents
        dataRng.Columns(1).Resize(.Count).Value = Application.Transpose(.keys)
        dataRng.Columns(1).Resize(.Count).TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:="|"
        dataRng.Columns(3).Resize(.Count).Value = Application.Transpose(.Items)
    End With
End Sub