VBA 操作 Excel 数据筛查

Sub cal()
'
' cal 宏
'

Dim num As Integer
Dim dataCol As Integer
Dim maxRow As Integer
Dim resultCol As Integer

num = 1
dataCol = 4
maxRow = 2728
resultCol = 6

For i = 1 To maxRow
For j = i + 1 To maxRow
If Cells(i, dataCol) = Cells(j, dataCol) And Not Cells(j, dataCol).Interior.Color = 65535 Then
Cells(j, dataCol).Interior.Color = 65535
End If
Next
Next

For i = 1 To maxRow
If Not Cells(i, dataCol).Interior.Color = 65535 Then
Cells(num, resultCol) = Cells(i, dataCol)
num = num + 1
End If
Next

End Sub