保护工作表后,VBA出现运行错误400提示,怎么办?

xunanming

1. Sub 重复数据标黄提示重复的行号()
   
2.     Dim i%, j%, s, brr
   
3.     Dim dic As Object, key, keys, items
   
4.     Sheet2.Unprotect 123456
   
5.     Set dic = CreateObject("scripting.dictionary")
   
6.     Sheet2.Activate
   
7.    
   
8.     Cells.Interior.Color = vbWhite
   
9.     Range("e2:e5001").ClearContents
   
10.    
    
11.     For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
    
12.      key = Cells(i, 4)
    
13.      dic(key) = dic(key) & "," & i
    
14.     Next
    
15.     For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
    
16.      key = Cells(i, 4)
    
17.      brr = Split(dic(key), ",")
    
18.      s = ""
    
19.      For j = 1 To UBound(brr)
    
20.           If brr(j) <> i Then
    
21.                s = s & "," & brr(j)
    
22.                Cells(i, 5).Interior.Color = vbYellow
    
23.                Cells(i, 3).Interior.Color = vbYellow
    
24.          End If
    
25.      Next
    
26.     If s <> "" Then
    
27.           Cells(i, 5) = "与第" & Mid(s, 2) & "行重复"
    
28.     End If
    
29.     Next
    
30.     Sheet2.Protect 123456
    
31. End Sub

复制代码

henry6

xunanming 发表于 2024-3-16 00:46

非常感谢您百忙之中对我的帮助，我比较一下两次代码的不同，努力理解一下。

wlianke

henry6 发表于 2024-3-15 20:47
谢谢指点,解决了保护工作表以后运行提示错误400的问题,

麻烦您再看一下,原代码在重复值三个及以上时, ...

Sub 重复数据标黄提示重复的行号()
    Dim i%, j%, s, brr, ss As String, x
    Dim dic As Object, key, keys, items
    Set dic = CreateObject("scripting.dictionary")
    Sheet2.Activate
   
    Cells.Interior.Color = vbWhite
    Range("e2:e5001").ClearContents
    x = 2
    For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
        key = Cells(i, 4)
        dic(key) = dic(key) & "," & i
    Next
    For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
        key = Cells(i, 4)
        brr = Split(dic(key), ",")
        s = ""
        For j = 1 To UBound(brr)
            If brr(j) <> i Then
                s = s & "," & brr(j)
                If UBound(brr) <= 2 Then
                ss = "与第" & Mid(s, 2) - 1 & "行重复"
                Else
                ss = ss & "与第" & Mid(s, x) - 1 & "行重复"
                x = x + 2
                End If
                Cells(i, 5).Interior.Color = vbYellow
                Cells(i, 3).Interior.Color = vbYellow
                Cells(i, 5) = ss
            End If
        Next
        ss = ""
        x = 2
    Next
End Sub

wlianke

henry6 发表于 2024-3-15 20:47
谢谢指点,解决了保护工作表以后运行提示错误400的问题,

麻烦您再看一下,原代码在重复值三个及以上时, ...

1. Sub 重复数据标黄提示重复的行号()
   
2.     Dim i%, j%, s, brr, ss As String, x
   
3.     Dim dic As Object, key, keys, items
   
4.     Set dic = CreateObject("scripting.dictionary")
   
5.     Sheet2.Activate
   
6.    
   
7.     Cells.Interior.Color = vbWhite
   
8.     Range("e2:e5001").ClearContents
   
9.     x = 2
   
10.     For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
    
11.         key = Cells(i, 4)
    
12.         dic(key) = dic(key) & "," & i
    
13.     Next
    
14.     For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
    
15.         key = Cells(i, 4)
    
16.         brr = Split(dic(key), ",")
    
17.         s = ""
    
18.         For j = 1 To UBound(brr)
    
19.             If brr(j) <> i Then
    
20.                 s = s & "," & brr(j)
    
21.                 If UBound(brr) <= 2 Then
    
22.                 ss = "与第" & Mid(s, 2) - 1 & "行重复"
    
23.                 Else
    
24.                 ss = ss & "与第" & Mid(s, x) - 1 & "行重复"
    
25.                 x = x + 2
    
26.                 End If
    
27.                 Cells(i, 5).Interior.Color = vbYellow
    
28.                 Cells(i, 3).Interior.Color = vbYellow
    
29.                 Cells(i, 5) = ss
    
30.             End If
    
31.         Next
    
32.         ss = ""
    
33.         x = 2
    
34.     Next
    
35. End Sub
    

复制代码

wlianke

henry6 发表于 2024-3-15 20:47
谢谢指点,解决了保护工作表以后运行提示错误400的问题,

麻烦您再看一下,原代码在重复值三个及以上时, ...

修改一下这个过程代码就好了
Sub 重复数据标黄提示重复的行号()
    Dim i%, j%, s, brr, ss As String, x
    Dim dic As Object, key, keys, items
    Set dic = CreateObject("scripting.dictionary") ###身份证核验查重 - 副本 - 副本.rar (200.96 KB, 下载次数: 0)

2024-3-18 11:27 上传

点击文件名下载附件

    Sheet2.Activate

    Cells.Interior.Color = vbWhite
    Range("e2:e5001").ClearContents
    x = 2
    For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
        key = Cells(i, 4)
        dic(key) = dic(key) & "," & i
    Next
    For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
        key = Cells(i, 4)
        brr = Split(dic(key), ",")
        s = ""
        For j = 1 To UBound(brr)
            If brr(j) <> i Then
                s = s & "," & brr(j)
                If UBound(brr) <= 2 Then
                ss = "与第" & Mid(s, 2) - 1 & "行重复"
                Else
                ss = ss & "与第" & Mid(s, x) - 1 & "行重复"
                x = x + 2
                End If
                Cells(i, 5).Interior.Color = vbYellow
                Cells(i, 3).Interior.Color = vbYellow
                Cells(i, 5) = ss
            End If
        Next
        ss = ""
        x = 2
    Next
End Sub