请各位老师帮助参详

smoodwaterbar

在工作中需要进行查重，在以前的贴中找到了各位老师提供的查重方法，但是由于需要一并排序的内容较多，做了部分修改之后，显示重复数量的列，始终不能移动到制定列。烦请各位老师参详一下。附件中是我已经修改过的。同时，如果可以，能否加入  按作者查重 选项。另外，现在的颜色标识只有一种，能否使用多种进行循环标志。附上未修改前的语句
Sub zjhm()
Application.ScreenUpdating = False
Range("f2:g65536").ClearContents
Range("a2:d65536").Sort key1:=Range("a2"), order1:=xlAscending
[a2:d247].Interior.ColorIndex = xlNone
Arr = [a1].CurrentRegion
n = 4
For i = 3 To UBound(Arr)
    If Arr(i, 1) = Arr(i - 1, 1) Then
       Cells(i - 1, 1).Resize(2, 1).Interior.ColorIndex = n
       Cells(i - 1, 7).Resize(1, 1) = i - 1
       Cells(i, 7).Resize(1, 1) = i
    End If
    If Cells(i - 1, 7) <> "" Then
       s = s + 1
       If s = 1 Then m = m + 1
       If m Mod 2 = 0 Then n = 6 Else n = 4
    Else
       If s > 1 Then Cells(i - 2, 6) = s
       s = 0
    End If
Next
Application.ScreenUpdating = True
End Sub
Sub sqxm()
Application.ScreenUpdating = False
Range("f2:g65536").ClearContents
Range("a2:d247").Sort key1:=Range("b2"), order1:=xlAscending
[a2:d247].Interior.ColorIndex = xlNone
Arr = [a1].CurrentRegion
n = 4
For i = 3 To UBound(Arr)
    a = Arr(i, 2) & Arr(i, 3) & Arr(i, 4)
    b = Arr(i - 1, 2) & Arr(i - 1, 3) & Arr(i - 1, 4)
    If a = b Then
       Cells(i - 1, 2).Resize(2, 3).Interior.ColorIndex = n
       Cells(i - 1, 7).Resize(1, 1) = i - 1
       Cells(i, 7).Resize(1, 1) = i
    End If
    If Cells(i - 1, 7) <> "" Then
       s = s + 1
       If s = 1 Then m = m + 1
       If m Mod 2 = 0 Then n = 6 Else n = 4
    Else
       If s > 1 Then Cells(i - 2, 6) = s
       s = 0
    End If
Next
Application.ScreenUpdating = True
End Sub
Sub quan()
Application.ScreenUpdating = False
Range("f2:g65536").ClearContents
Range("a2:d247").Sort key1:=Range("a2"), order1:=xlAscending
[a2:d247].Interior.ColorIndex = xlNone
Arr = [a1].CurrentRegion
n = 4
For i = 3 To UBound(Arr)
    a = Arr(i, 1) & Arr(i, 2) & Arr(i, 3) & Arr(i, 4)
    b = Arr(i - 1, 1) & Arr(i - 1, 2) & Arr(i - 1, 3) & Arr(i - 1, 4)
    If a = b Then
       Cells(i - 1, 1).Resize(2, 4).Interior.ColorIndex = n
       Cells(i - 1, 7).Resize(1, 1) = i - 1
       Cells(i, 7).Resize(1, 1) = i
    End If
    If Cells(i - 1, 7) <> "" Then
       s = s + 1
       If s = 1 Then m = m + 1
       If m Mod 2 = 0 Then n = 6 Else n = 4
    Else
       If s > 1 Then Cells(i - 2, 6) = s
       s = 0
    End If
Next
Application.ScreenUpdating = True
End Sub

粗查重调整1.zip (19.06 KB, 下载次数: 3)

2018-6-14 15:48 上传

点击文件名下载附件

smoodwaterbar

烦请各位老师帮忙看看

yylucke

smoodwaterbar 发表于 2018-6-20 09:03
烦请各位老师帮忙看看

真心的建议：你直接告诉需求，比看你的代码要快的多。另，既然有ISBN，那就是唯一编码，以此来判断是否重复是最好的字段。
作者重复？难道不能出现同一个作者有多个书籍？