目的:查找重复行,并标记出来。有意思的地方在于,不同于以前处理的简单双重循环,这里需要在外层循环进行限定(num = num + 1),以避免冗余运算。
Option Explicit
Sub Lookup()
Dim r As Long, c As Long, i As Integer, j As Integer, num As Integer, _
Delete_num As Integer
Dim myRange As Range
Dim myFon As Font
'r为行数,c为列数,i为外层循环数控制,j为内层循环数控制
Set myRange = ActiveSheet.UsedRange
myRange.ClearFormats
'myRange.ClearFormats
r = myRange.Rows.Count
Debug.Print r
c = myRange.Columns.Count
num = 3
Delete_num = 0
'查找重复行
If myRange.Cells(2, 1) = myRange.Cells(4, 1) Then
Debug.Print "第" & 111111; "行为重复行"
End If
For i = 2 To r
Debug.Print "第" & i; "行"
For j = num To r
If myRange.Cells(i, 1) = myRange.Cells(j, 1) And _
myRange.Cells(i, 4) = myRange.Cells(j, 4) Then
Debug.Print "第" & j & "行为重复行"
' 'myRange.Cells(i, 1).EntireRow.Delete shift:=xlShiftUp 'xlShiftToLeft
Delete_num = Delete_num + 1
myRange.Cells(j, 2).Value = "Delete Row Found"
Set myFon = myRange.Cells(j, 1).EntireRow.Font
With myFon
.Name = "楷体"
.Size = 15
.Bold = True
.Italic = True
.Color = RGB(255, 0, 0)
.Strikethrough = True '水平删除线
.Underline = xlUnderlineStyleNone 'xlUnderlineStyleSingle 'xlUnderlineStyleDouble
.Shadow = False '是/否无变化??
.Subscript = False
.Superscript = False
'具体属性设置参看:https://docs.microsoft.com/zh-cn/office/vba/api/excel.xlpattern
End With
End If
Next
num = num + 1
Next
MsgBox "共有: " & Delete_num & "条重复记录"
End Sub