查找重复行，并标记

最新推荐文章于 2024-01-20 18:25:14 发布

原创最新推荐文章于 2024-01-20 18:25:14 发布 · 2.6k 阅读

CC 4.0 BY-SA版权

目的：查找重复行，并标记出来。有意思的地方在于，不同于以前处理的简单双重循环，这里需要在外层循环进行限定（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