如何插入上色代码

ddz79101

老师！有2个表，是按姓名提取金额，代码可以运行，但感觉少了一句提示没有被提取到用户名的提示，我想加入一句，对没有被提取到用户名涂色，望老师指点。谢谢！

liulang0808

看了楼主的附件，模拟数据不是太多，内容逻辑上有点疑问
第一张表，关键项有重复，对应到第二张表，按照楼主这个对应方式，那么就是最后一个对应过去
还有就是第二张表的关键字列是否有重复？

ddz79101

liulang0808 发表于 2024-1-16 13:47
看了楼主的附件，模拟数据不是太多，内容逻辑上有点疑问
第一张表，关键项有重复，对应到第二张表，按照楼 ...

老师！第2张表的关键字“用户名”是没有重复的，第1张表是有可能出现关键字“用户名”重复的，从以往操作的结果看第1张表中用户名重复往往是新增的，重复是因为第2张表有个时间截止原因产生，所以我就没有手工操作整理第1张表的用户名

liulang0808

Sub TEXT()
    Dim r%, i%
    Dim arr, brr
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
    r = Worksheets("2").Cells(Rows.Count, 1).End(xlUp).Row
    arr = Worksheets("2").Range("a2:aa" & r)
    For i = 1 To UBound(arr)
        d(arr(i, 2)) = i
    Next
    With Worksheets("1")
         r = .Cells(.Rows.Count, 8).End(xlUp).Row - 1
         brr = .Range("h2:j" & r)
         For i = 1 To UBound(brr)
            If d.exists(brr(i, 1)) Then
                arr(d(brr(i, 1)), 27) = brr(i, 3)
            Else
                .Cells(i + 1, "h").Interior.ColorIndex = 6
            End If
         Next
    End With
   
   Worksheets("2").Range("a2:aa" & UBound(arr)) = arr
End Sub

liulang0808

如何插入涂色代码00.zip (11.94 KB, 下载次数: 10)

2024-1-16 14:33 上传

点击文件名下载附件

代码顺序跟逻辑调整了下，供参考

ddz79101

liulang0808 发表于 2024-1-16 14:34
代码顺序跟逻辑调整了下，供参考

谢谢老师！完全正确！

680926

Sub 涂色代码()
    Dim arr, brr
    arr = Sheets("2").Range("a1").CurrentRegion
    brr = Sheets("1").Range("a1").CurrentRegion
    For j = 2 To UBound(brr)
        p = 0
        For i = 2 To UBound(arr)
            If brr(j, 2) = arr(i, 2) Then
                p = 1
                GoTo 100
            End If
        Next
100
   If p = 0 Then Cells(j, 2).Interior.ColorIndex = 3
    Next
End Sub