Excel·VBA单元格重复值标记颜色

76 篇文章 23 订阅

《excelhome提问-标记重复值的问题》,对同一行的多列内容都重复的标记颜色

仅需选中要标记颜色的多列,即可运行代码;且不同的重复值标记不同颜色
注意:由于使用了Union函数,故不支持单列;区分字母大小写

Sub 选中列重复标记颜色()
    '适用多列选中、多列部分选中,选中区域内整行重复的标记颜色(合并单元格不影响)
    Dim rng As Range, dict As Object, first_row, last_row, first_col, last_col, i, j, res, rang_count, temp, v, c
    Set rng = Intersect(ActiveSheet.UsedRange, Selection)  'intersect语句避免选择整列造成无用计算
    If rng.Columns.count = 1 Then Debug.Print "不支持单列": Exit Sub  '不支持单列,退出
    first_row = rng.Row     '选中区域开始行号
    last_row = first_row + rng.Rows.count - 1  '选中区域结束行号
    first_col = rng.Column  '选中区域开始列号
    last_col = first_col + rng.Columns.count - 1  '选中区域结束列号
    rang_count = rng.Columns.count  '每行单元格数
    Set dict = CreateObject("scripting.dictionary")
    
    For i = first_row To last_row
        res = ""
        For j = first_col To last_col
            res = res & CStr(Cells(i, j).Value)
        Next
        Set temp = Range(Cells(i, first_col), Cells(i, last_col))  '选中区域每行为一个range
        If Not dict.Exists(res) And res <> "" Then  '新键,且不为空值
            Set dict(res) = temp
        ElseIf res <> "" Then
            Set dict(res) = Union(dict(res), temp)
        End If
    Next
    v = dict.Items
    c = 2  '开始颜色index,1为黑2为白
    For i = 0 To dict.count - 1
        If v(i).count > rang_count Then
            c = c + 1
            v(i).Interior.ColorIndex = c
            If c >= 56 Then c = 2  '颜色循环
        End If
    Next
    
End Sub

举例

选中A-D列,运行代码,获得结果
在这里插入图片描述

  • 2
    点赞
  • 15
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 0
    评论
好的,您的问题是如何使用 VBA 进行两个 Excel 文件中的数据对比,并将不一致的单元格标记为红色。 以下是一个示例代码,它可以帮助您实现这个功能: ```VBA Sub CompareTwoWorkbooks() Dim wb1 As Workbook, wb2 As Workbook Dim ws1 As Worksheet, ws2 As Worksheet Dim row As Integer, col As Integer Set wb1 = Workbooks.Open("C:\Workbook1.xlsx") '第一个 Excel 文件的路径和名称 Set wb2 = Workbooks.Open("C:\Workbook2.xlsx") '第二个 Excel 文件的路径和名称 Set ws1 = wb1.Worksheets("Sheet1") '第一个 Excel 文件中的 Sheet 页名称 Set ws2 = wb2.Worksheets("Sheet1") '第二个 Excel 文件中的 Sheet 页名称 For row = 1 To ws1.UsedRange.Rows.Count '循环行 For col = 1 To ws1.UsedRange.Columns.Count '循环列 If ws1.Cells(row, col) <> ws2.Cells(row, col) Then '比较单元格 ws1.Cells(row, col).Interior.Color = vbRed '将不一致的单元格标记为红色 End If Next col Next row wb1.Close False '关闭第一个 Excel 文件,不保存更改 wb2.Close False '关闭第二个 Excel 文件,不保存更改 End Sub ``` 上述代码与之前的示例代码非常相似,唯一的区别是它打开了两个 Excel 文件并将其作为工作簿对象进行操作。 具体来说,我们使用 `Workbooks.Open` 函数打开两个 Excel 文件,并使用 `Worksheets` 属性获取这些文件中的 Sheet 页。然后,我们使用嵌套的循环来遍历两个 Sheet 页中的所有单元格,并使用 `If` 语句来比较单元格是否相等。如果不相等,我们将使用 `ws1.Cells(row, col).Interior.Color` 将单元格的背景色设置为红色,以标记不一致的单元格。 最后,我们使用 `wb1.Close` 和 `wb2.Close` 函数关闭打开的 Excel 文件,不保存更改。 请注意,在使用上述代码之前,您需要将文件路径和名称替换为实际使用的 Excel 文件的路径和名称。

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

薛定谔_51

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值