查找重复行,并标记

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

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值