Sub MC_TEST()
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To [A65536].End(3).Row
d(Cells(i, 1).Value) = d(Cells(i, 1).Value) & "|" & i
Next
ar = d.keys: br = d.items
For n = 0 To UBound(ar)
ss = Split(br(n), "|")
If UBound(ss) > 1 Then
Range("b" & ss(1)) = UBound(ss)
Range("c" & ss(1)) = ss(1)
Range("d" & ss(1)) = ss(UBound(ss))
End If
Next
Set d = Nothing
End Sub
这个可以把重复的值过滤成不重复的值,放到表2里去统计,比较科学。
重复个数=IF(COUNTIF(Sheet1!A:A,Sheet2!A2)<2,0,COUNTIF(Sheet1!A:A,Sheet2!A2))
重复开始行=IF(COUNTIF(Sheet1!A:A,Sheet2!A2)=1,"没重复项目",SMALL(IF(Sheet1!A:A=A2,ROW(Sheet1!A:A),4^8),1))
重复结束行=IF(COUNTIF(Sheet1!A:A,Sheet2!A2)=1,"没重复项目",MATCH(1,0/(Sheet1!A:A=Sheet2!A2)))
Sub 按钮4_Click()
gs = 1
qs = 1
js = 1
For i = 2 To [a65536].End(3).Row + 1
If Cells(i, 1) <> Cells(i - 1, 1) Then
js = i - 1
If gs > 1 Then
Cells(qs, 2) = gs
Cells(qs, 3) = qs
Cells(qs, 4) = js
End If
qs = i
Else
gs = gs + 1
End If
Next
End Sub
Sub 重复数统计()
Dim N%, Ro%
N = 1: Ro = [A65536].End(3).Row + 1
Range("B2:D" & Ro).ClearContents
For i = 2 To Ro
If Range("A" & i) = Range("A" & i - 1) Then
N = N + 1
Else
If N > 1 Then Cells(i - N, 2).Resize(, 3) = Array(N, i - N, i - 1)
N = 1
End If
Next
End Sub
文件给我 我给你弄