Question

我有一列数据，其中我有字符串值。我想对该列中的每个单元格进行比较，并检查该值是否重复。比较需要是全文和外卡。

下面是我的数据的屏幕截图

如果您看到屏幕截图，公司CES Limited与第三行以及第17行一起存在于另一家公司ECLERX SERVICES LTD | CES有限公司。所以我想突出显示像这样的重复值。

以下是我写的代码

Dim rangeToUse As Range, singleArea As Range, cell1 As Range, cell2 As Range, i As Integer, j As Integer

Set rangeToUse = Selection

Cells.Interior.ColorIndex = 0
Cells.Borders.LineStyle = xlNone

For Each singleArea In rangeToUse.Areas
    singleArea.BorderAround ColorIndex:=1, Weight:=xlThin
Next singleArea

For i = 1 To rangeToUse.Areas.Count
    For Each cell1 In rangeToUse.Areas(i)
    MsgBox cell1.Value
        For j = 1 To rangeToUse.Areas.Count
                For Each cell2 In rangeToUse.Areas(j)
                    If cell1.Value = cell2.Value Then
                        cell2.Interior.ColorIndex = 38
                    End If
                    MsgBox cell2.Value
                Next cell2
        Next j
    Next cell1
Next i

然而，代码将所有单元格突出显示为不同。谁能让我知道我做错了什么？

Answer 1

这将为您提供选择中出现的次数

WorksheetFunction.CountIf（rangeToUse，“”＆amp; cell2＆amp;“”）

您似乎正在迭代非连续选择。如果要计算cell2区域中出现的次数，请使用

WorksheetFunction.CountIf（rangeToUse.Areas（j），“”＆amp; cell2＆amp;“”）

Answer 2

在我看来，您正在编码以匹配确切的单元格值，但在您的示例中，您说明了CES Limited和ECLERX SERVICES LTD | CES Limited应该返回一场比赛。

您还需要考虑如何将其标记为不同的颜色，如果ECLERX再次出现在其自身/其他内容上会发生什么情况，那会变成什么颜色？

如果你真的只想按照下面的代码返回重复项，你或许能够实现这一点，如果你需要单独和颜色代码公司，你可能需要在单元格中拆分字符串，如果这对您有效，它将标记一个单元格的整个字符串构成其他任何一个单元格的一部分，方法是在其旁边的列中放置1：

class A {
    public String a;
    public String b;
}

Answer 3

您的代码总是会发现重复，因为您的比较之一始终是自己的单元格。

这是一个使用Collection对象检测重复项的方法。如果您尝试添加具有与现有项目相同的项目的项目，则集合将返回错误。我们测试一下。

当您在单元格中有两个（或更多）时，我们还需要拆分公司名称。在您的示例中，它们似乎被|（由空格包围的管道）拆分，但检查有时屏幕截图并不理想。

看看这是否可以让你开始：

Option Explicit
Sub ColorDups()
Dim rangeToUse As Range, singleArea As Range, cell1 As Range, cell2 As Range, i As Integer, j As Integer
Set rangeToUse = [a1:a23] 'hard coded for testing

Cells.Interior.ColorIndex = 0
Cells.Borders.LineStyle = xlNone

For Each singleArea In rangeToUse.Areas
    singleArea.ClearFormats
    singleArea.BorderAround ColorIndex:=1, Weight:=xlThin
Next singleArea

'Generate Unique companies list and flag duplicates
Dim colCompanies As Collection
Dim vCompany As Variant
Dim S(0 To 1) As String
Set colCompanies = New Collection
On Error Resume Next
For i = 1 To rangeToUse.Areas.Count
    For Each cell1 In rangeToUse.Areas(i)
        vCompany = Split(cell1.Text, " | ")
        For j = LBound(vCompany) To UBound(vCompany)
            S(0) = Trim(vCompany(j))
            S(1) = cell1.Address
            colCompanies.Add S, S(0)
            Select Case Err.Number
                Case 457 'we have a duplicate
                    Err.Clear
                    cell1.Interior.ColorIndex = 38
                    Range(colCompanies(S(0))(1)).Interior.ColorIndex = 38
                Case Is <> 0 'debugstop
                    Debug.Print Err.Number, Err.Description
                    Stop
            End Select
        Next j
    Next cell1
Next i
On Error GoTo 0

End Sub

这是使用您的数据和上述宏的结果。您可以通过使用几种不同的颜色和/或输出匹配的单元格范围来增强;等

使用vba删除excel中的重复行

3 个答案: