让颜色随对应数据更新自动显示

salen0913

用条件格式设置，会因为复制/格式刷等会把规则应用单元格弄乱，又得重新设置一遍挺麻烦的，所以我想改用VBA的方式做，每次往里面写数据的时候让它自动显示，附件已上传，求助各位大神，辛苦了！！！

salen0913

之前的太复杂了，稍微简化了下需求，有没有大神相助一下！

gwjkkkkk

salen0913 发表于 2023-3-16 18:55
之前的太复杂了，稍微简化了下需求，有没有大神相助一下！

第2个条件已设定条件格式，不需要处理，第1个写了一下，请参考。。。

salen0913

gwjkkkkk 发表于 2023-3-16 21:36
第2个条件已设定条件格式，不需要处理，第1个写了一下，请参考。。。

都能设定条件   可是在复制或者进行操作的时候   条件就自动变单元格了   需要全用VBA的方式显示

3190496160

Sub 填充颜色()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With ActiveSheet
    r = .Cells(Rows.Count, 4).End(xlUp).Row
    .Range("a2:g" & r).Interior.ColorIndex = 0
    .Range("d2:g" & r).Font.Strikethrough = False
    For i = 2 To r
        If Trim(.Cells(i, 7)) <> "" Then
            If IsDate(.Cells(i, 7)) Then
                .Cells(i, 4).Resize(1, 4).Interior.ColorIndex = 15
                .Cells(i, 7).Font.Strikethrough = True
            End If
        End If
        If Trim(.Cells(i, 1)) <> "" Then
            zd = Trim(.Cells(i, 1)) & "|" & Trim(.Cells(i, 3))
            d(zd) = d(zd) + 1
        End If
    Next i
    For Each k In d.keys
        For i = 2 To r
            If Trim(.Cells(i, 1)) <> "" Then
                zd = Trim(.Cells(i, 1)) & "|" & Trim(.Cells(i, 3))
                If zd = k Then
                    sl = d(zd)
                    If sl > 1 Then
                        .Cells(i, 1).Resize(1, 3).Interior.ColorIndex = 45
                    End If
                End If
            End If
        Next i
    Next k
End With
MsgBox "ok!"
End Sub

3190496160

3190496160

VBA1.rar (22.98 KB, 下载次数: 5)

2023-3-17 09:26 上传

点击文件名下载附件

salen0913

3190496160 发表于 2023-3-17 09:24
Sub 填充颜色()
Dim d As Object
Set d = CreateObject("scripting.dictionary")

我的意思是让他自动显示，要写在事件编程里，这个不知道怎么选

3190496160

salen0913 发表于 2023-3-17 13:42
我的意思是让他自动显示，要写在事件编程里，这个不知道怎么选

哈哈哈，点击一下按钮很费劲？？

3190496160

salen0913 发表于 2023-3-17 13:42
我的意思是让他自动显示，要写在事件编程里，这个不知道怎么选

先学会送花和说声谢谢，再谈其他的吧