如何突出显示列中不是空白的重复项?

问题描述

我想突出显示第一列中所有连接字符串的重复项，如果有突出显示的重复项，则提供一条错误消息.但是，该列中有几个空白单元格，我不希望它们在运行宏时显示为重复项.

I want to highlight all the duplicates of a concatenated string in column I and provide an error message if there are any duplicates highlighted. However, there are several blank cells in the column and I do not want these to show up as duplicates when I am running the macro.

我从这里获得了以下代码:

I got this code from on here:

Sub HighlightDuplicateValues()
    Dim myRange As Range

    Range("I1", Range("I1").End(xlDown)).Select

    Set myRange = Selection

    For Each myCell In myRange
        If Not IsEmpty(ActiveCell.Value) = True Then
            If WorksheetFunction.CountIf(myRange, myCell.Value) > 1 Then
                myCell.Interior.ColorIndex = 36
            End If    
        End If   
    Next myCell 
End Sub

我绝对没有VBA的经验，但据我所知，这似乎应该可行.但是，最终发生的事情是几乎所有我的数据都被删除了.真是不幸.

I have absolutely no experience in VBA but from what little I understand it seems like it should work. However, what ends up happening is nearly all my data gets deleted. It's rather unfortunate.

同样，我想突出显示连接的列I中的所有重复项，但是我不希望这些空白单元格被视为重复项.弹出错误消息的代码将是一个很好的附加好处，但目前并不是我的主要重点.

Again, I want to highlight any duplicates in the concatenated column I, but I don't want these blank cells to count as duplicates. Having the code for an error message to pop up would be an excellent added bonus, but is not currently my main focus.

推荐答案

如果您想使用VBA，这应该适合您.

If you want to use VBA this should work for you.

    Dim mydict As Object
    Dim iter As Long
    Dim lastrow As Long
    Dim errmsg As String
    Dim key As Variant

    Set mydict = CreateObject("Scripting.Dictionary")

    ' If you want to use early binding add in the Microsoft Scripting Runtime reference then: Set mydict = new dictionary

    With ActiveSheet
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For iter = 2 To lastrow
            If Not mydict.exists(.Cells(iter, "A").Value) Then
                mydict.Add .Cells(iter, "A").Value, False
            Else
                .Cells(iter, "A").Interior.ColorIndex = 36
                mydict(.Cells(iter, "A").Value) = True 'Keep track of which values are repeated
            End If
        Next
    End With
    errmsg = "Duplicate Values: "
    For Each key In mydict
        If mydict(key) = True Then 'Dupes
            If Not errmsg = "Duplicate Values: " Then 'No extra comma
                errmsg = errmsg & ", " & key
            Else
                errmsg = errmsg & " " & key
            End If
        End If
    Next

    MsgBox errmsg

这篇关于如何突出显示列中不是空白的重复项?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！