求高手帮忙做个VBA，谢谢

疾驰的蜗牛

求高手帮忙做个VBA，谢谢。详情请见附件

大灰狼1976

做了个示例，最前面插入了一列，便于标识对应关系，最后的标色不难实现，但是标在哪里并不明确，所以没做。附件请参考。

1. Private Sub CommandButton1_Click()
   
2. Dim arr, brr, i&, j&, k&
   
3. arr = [b1].CurrentRegion
   
4. ReDim brr(1 To 8, 1 To UBound(arr, 2))
   
5. For j = 1 To UBound(arr, 2)
   
6.   For i = UBound(arr) To 2 Step -1
   
7.     For k = i - 1 To 1 Step -1
   
8.       If arr(k, j) <> arr(i, j) Then Exit For
   
9.     Next k
   
10.     If i = UBound(arr) Then brr(8, j) = i - k
    
11.     If brr(arr(i, j) + 1, j) < i - k Then brr(arr(i, j) + 1, j) = i - k
    
12.     i = k + 1
    
13.   Next i
    
14. Next j
    
15. [b16].Resize(8, UBound(brr, 2)) = brr
    
16. End Sub

复制代码