根据单元格内容填充整行颜色

529905149

表格不是很规则，根据C列单元格,文本相同则填充整行颜色，谢谢

木子客

看了一下你的表格和你的代码，不是很明白你要达到的效果是依据什么来判断的，数据中没有一个是日期，但是你的判断条件是判断日期。数据放在C列，你判断的是A列

529905149

木子客 发表于 2024-6-24 10:51
看了一下你的表格和你的代码，不是很明白你要达到的效果是依据什么来判断的，数据中没有一个是日期，但是你 ...

这是抄袭别人的未成功，小白一枚

木子客

529905149 发表于 2024-6-24 11:11
这是抄袭别人的未成功，小白一枚

你都没描述清楚你要达到的效果是什么样的

gwjkkkkk

不知道是不是这个效果。。。

529905149

自己解决了
Sub 列文本相同则标记为同色()
Dim ws As Worksheet
    Dim clr As Long
    Dim rng As Range
    Dim cell As Range
    Dim r As Range
   
    Set ws = ThisWorkbook.Sheets(ActiveSheet.Name)
    Set rng = ws.Range("c1:c" & Range("c" & ws.Rows.Count).End(xlUp).Row)
    With rng
        Set r = .Cells(.Cells.Count)
    End With
    rng.Interior.ColorIndex = xlNone
    clr = 3
    For Each cell In rng
        If Application.WorksheetFunction.CountIf(rng, cell) > 1 Then
            'addresses will match for first instance of value in range
            If rng.Find(What:=cell, LookAt:=xlWhole, MatchCase:=False, After:=r).Address = cell.Address Then
                'set the color for this value (will be used throughout the range)
                cell.Interior.ColorIndex = clr
                clr = clr + 1
                '另一种方法把表中数字部分单元格删除.:将  clr = clr + 1 替换成  If clr = 44 Then clr = 46 Else clr = 44
                  
                End If
            Else
                'if not the first instance, set color to match the first instance
                cell.Interior.ColorIndex = rng.Find(What:=cell, LookAt:=xlWhole, MatchCase:=False, After:=r).Interior.ColorIndex
            End If
        End If
    Next
    End Sub