修改代码

xing_chen

老师，有簿，需跨表比对其中有人员无金额的标色。簿中写有代码，但未能实现目标。敬请老师修改赐教。谢谢！

shiruiqiang

新手解题思路：把表一作为字典，然后表二的d.exists再判断“an”列是否为空，空的话标红。另：按照你的思路，字典都对不起来。仅供参考，参照你的思路写，等审核

shiruiqiang

按照你的解题思路，首先把表2的第40列为空的人员作为字典，再去判断表一，dic.exists的标红。另：数据大大话需要union集合

xing_chen

shiruiqiang 发表于 2023-2-11 07:52
新手解题思路：把表一作为字典，然后表二的d.exists再判断“an”列是否为空，空的话标红。另：按照你的思路 ...

老师，早上好！那么怎么修改才能让代码和我的思路合拍喃？能否再进一步具体指点。谢谢

鄂龙蒙

xing_chen 发表于 2023-2-11 08:04
老师，早上好！那么怎么修改才能让代码和我的思路合拍喃？能否再进一步具体指点。谢谢

Sub test()
    Dim arr, i&, dic As Object, rng As Range
    Set dic = CreateObject("Scripting.Dictionary")
    arr = Sheets(2).[a1].CurrentRegion
    For i = 2 To UBound(arr)
      If arr(i, 40) = "" Then
        dic(arr(i, 3)) = ""
      End If
    Next i
    arr = [b1].CurrentRegion
    For i = 2 To UBound(arr)
      If dic.exists(arr(i, 2)) Then
         If Not rng Is Nothing Then
            Set rng = Union(rng, Cells(i, 2).Resize(, 3))
        Else
            Set rng = Cells(i, 2).Resize(, 3)
         End If
      End If
    Next i
    If Not rng Is Nothing Then
      Cells.Interior.ColorIndex = 0
      rng.Interior.Color = vbRed
    End If
    Set dic = Nothing
    Beep
End Sub

鄂龙蒙

If Not  dic.exists(arr(i, 2)) Then    改成    If dic.exists(arr(i, 2)) Then   去掉    Not  

3190496160

xing_chen

shiruiqiang 发表于 2023-2-11 08:00
按照你的解题思路，首先把表2的第40列为空的人员作为字典，再去判断表一，dic.exists的标红。另：数据大大 ...

谢谢老师！运行如愿。

xing_chen

3190496160 发表于 2023-2-11 08:48

谢谢老师！运行如愿。

xing_chen

鄂龙蒙 发表于 2023-2-11 08:29
If Not  dic.exists(arr(i, 2)) Then    改成    If dic.exists(arr(i, 2)) Then   去掉    Not

老师，根据你的建议。改了这一句，没有达到目标。是否还需要动手术。