演示效果和代码如下。文件已上传，下载地址：/s/1o6yoYXO Sub tj()Dim d, kySet d = CreateObject(Scripting.Dictionary)Dim i, j, k, r, n, c, fst As Longr = Range(A & Rows.Count).End(xlUp).RowDim AKArr, MNArrAKArr = Range(A1:K & r)For i = r - 3 To 1 Step -1 For j = 2 To 11 AKArr(r, j) = --Right(AKArr(i + 1, 1) + AKArr(i + 2, 1) + j - 2, 1) Next j n = 0: c = 0 For k = r - 1 To r - i Step -1 fst = --Right(AKArr(k - (r - i - 1), 1) + AKArr(k - (r - i - 1) + 1, 1), 1) j = --Right(--AKArr(k, 1) + 10 - fst, 1) + 2 If k = r - 1 Then c = j: n = n + 1 Else If j = c Then n = n + 1 Else Exit For End If Next k If d.exists(AKArr(r, c) & _ & n) Then d(AKArr(r, c) & _ & n) = d(AKArr(r, c) & _ & n) + 1 Else d(AKArr(r, c) & _ & n) = 1 End IfNext iMNArr = Range(M1:N & d.Count + 1)MNArr(1, 1) = 数字（连续次数）MNArr(1, 2) = 出现总个数n = 2For Each ky In d.keys If Split(ky, _)(1) 1 Then MNArr(n, 1) = Replace(ky, _, 连续) & 次 Else MNArr(n, 1) = Left(ky, InStr(ky, _) - 1) End If MNArr(n, 2) = d(ky) n = n + 1NextColumns(M:M).NumberFormatLocal = @Range(M:N).ClearContentsRange(M1:N & d.Count) = MNArrWith ActiveSheet.Sort .SortFields.Add Key:=Range(M1) .SetRange Range(M1:N & d.Count) .Header = xlYes .ApplyEnd WithColumns(M:M).TextToColumnsColumns(M:N).AutoFitColumns(M:N).HorizontalAlignment = xlCenterSet d = NothingEnd Sub
