无法选择指定单元

困顿的人

简单说说要求 第一个表格中 根据b15:b19内容 选择表格中姓名栏只出现一次的所在行 小弟写了代码 运行正常 不知道什么原因 无法选择 爱3看 那一行 麻烦大神帮我看看代码哪里有问题 谢谢

gwjkkkkk

Sub TEST2()
    Dim arr, i&, dic As Object, rng As Range
   
    Set dic = CreateObject("Scripting.Dictionary")
   
    arr = [A1].CurrentRegion
    For i = 3 To UBound(arr)
        dic(arr(i, 2)) = dic(arr(i, 2)) + 1
    Next i
    For i = 3 To UBound(arr)
        If dic(arr(i, 2)) = 1 Then
           If rng Is Nothing Then
              Set rng = Rows(i)
           Else
              Set rng = Union(rng, Rows(i))
           End If
        End If
    Next i
   
    If Not rng Is Nothing Then rng.Select
    Beep
End Sub

gwjkkkkk

请楼主参考附件。。。

困顿的人

gwjkkkkk 发表于 2023-1-1 17:35
请楼主参考附件。。。

老师 代码无法达到要求 表格区域是a1:o14
b15:b19是筛选条件区域 根据条件区域 选择表格区域中只出现了一次姓名的行 即选择表格中出现了 爱3看 深色 宿舍 西卡 等姓名所在的行

gwjkkkkk

困顿的人 发表于 2023-1-1 17:48
老师 代码无法达到要求 表格区域是a1:o14
b15:b19是筛选条件区域 根据条件区域 选择表格区域中只出现了 ...

改一句代码就可以了，请楼主参考附件。。。

困顿的人

gwjkkkkk 发表于 2023-1-1 17:54
改一句代码就可以了，请楼主参考附件。。。

老师 改动以后 金正和金2正 所在的行也被选择了  还是无法达到要求

gwjkkkkk

不知道是不是这个意思。。。

3190496160

Sub 条件选择行()
Dim ar As Variant, br As Variant
Dim rn As Range
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheets("重复数据")
    r = .Cells(Rows.Count, "c").End(xlUp).Row
    If r < 3 Then MsgBox "数据源区域为空！": End
    ar = .Range("b1:b" & r)
    rs = .Cells(Rows.Count, "t").End(xlUp).Row
    If rs < 1 Then MsgBox "条件区域为空！": End
    br = .Range("t1:t" & rs)
    For i = 1 To UBound(br)
        If VBA.Trim(br(i, 1)) <> "" Then
            dc(VBA.Trim(br(i, 1))) = ""
        End If
    Next i
    For i = 3 To UBound(ar)
        If VBA.Trim(ar(i, 1)) <> "" Then
            If dc.exists(VBA.Trim(ar(i, 1))) Then
                d(VBA.Trim(ar(i, 1))) = d(VBA.Trim(ar(i, 1))) + 1
            End If
        End If
    Next i
    For i = 3 To UBound(ar)
        If VBA.Trim(ar(i, 1)) <> "" Then
            sl = d(VBA.Trim(ar(i, 1)))
            If sl = 1 Then
                If rn Is Nothing Then
                    Set rn = .Rows(i)
                Else
                    Set rn = Union(rn, .Rows(i))
                End If
            End If
        End If
    Next i
    If Not rn Is Nothing Then rn.Select
End With
MsgBox "ok!"
Set d = Nothing
Set dc = Nothing
End Sub

3190496160

标准表格难题.rar (30.41 KB, 下载次数: 6)

2023-1-2 10:52 上传

点击文件名下载附件

困顿的人

3190496160 发表于 2023-1-2 10:52

谢谢老师 已经完美解决