Sub xyf()
Dim arr As New Collection
Dim arr1 As New Collection
maxnban = 0
maxban = 0
i = 1
Do While Cells(i, 1).Value <> ""
arr.Add Cells(i, 1).Value
If arr(1) < 8000 Then
arr1.Add Cells(i, 1).Value
End If
If maxnban < arr(i) Then
maxnban = arr(i)
End If
i = i + 1
Loop
For i = 1 To arr1.Count Step 1
If maxban < arr1(i) Then
maxban = arr1(i)
End If
Next
arrconut = arr.Count
Cells(1, 2).Value = arr(1)
For i = 1 To arrconut Step 1
If i = arrconut Then
Exit For
End If
fban = arr(i)
sban = arr(i + 1)
If fban <> sban Then
Cells(i + 1, 2).Value = sban
End If
If fban = sban Then
If fban >= 8000 Then
maxnban = maxnban + 1
Cells(i + 1, 2).Value = maxnban
Else
maxban = maxban + 1
Cells(i + 1, 2).Value = maxban
End If
End If
Next
End Sub