Excel VBA - 突出显示重复的单元格值 - 段落（长字符串）答案

【问题标题】：Excel VBA - Highlighting Duplicate Cell Values - Paragraphs (Long Strings)Excel VBA - 突出显示重复的单元格值 - 段落（长字符串）
【发布时间】：2018-05-11 16:56:50
【问题描述】：

我搜索了论坛并找到了一些很棒的 Excel VBA 代码来查找和突出显示给定数据集范围内的重复单元格值。

但是，我的数据集中的单元格值是段落。这意味着数据集中的某些单元格值将大于 255 个字符。当我运行下面的代码时，重复的单元格会突出显示，直到代码遇到大于 255 个字符的单元格值。这似乎导致“countif”函数抛出错误：

运行时错误“1004”：无法获取 WorksheetFunction 类的 CountIf 属性

关于如何将大于 255 个字符的 Cell.Value 传递给 CountIf 的任何想法，或比较大于 255 个字符的单元格值以突出显示重复项的其他想法？

Sub findDuplicates()
Const headRow As Integer = 7 'row that contains the table heading row for the dataset
Dim lastRow As Integer
Dim rng As Range

With ThisWorkbook.Worksheets(1)
    lastRow = .Range("F" & Rows.Count).End(xlUp).Row 'finds last row in dataset
    Set rng = .Range(Cells(headRow + 1, 6), Cells(lastRow, 6)) 'sets the range of the dataset between the headRow and lastRow
End With

For Each Cell In rng
    If Application.WorksheetFunction.CountIf(rng, Cell.Value) > 1 Then 'tests if there is a duplicate
        Cell.Interior.ColorIndex = 6 'highlight yellow
    End If
Next Cell
End Sub

【问题讨论】：

您可以循环遍历范围并查看一个单元格是否等于另一个单元格。如果由于数据的大小而需要很长时间，您可以将数据存储在 VBA 数组中并在那里进行循环。

标签： excel vba countif

【解决方案1】：

我建议将长文本转换为一些数值。查看我的功能：

Function UnicodeVal(str As String) As Double
Dim l As Long
Dim dblV As Double

dblV = 1
For l = 1 To Len(str)
    If l Mod 2 Then
        dblV = dblV * AscW(Mid(str, l, 1))
    Else
        dblV = dblV / AscW(Mid(str, l, 1))
    End If
    UnicodeVal = dblV
Next l

该函数将字符串中所有字符的 Unicode 值相乘和相除，并返回分数。因为它是乘以偶数并除以奇数，所以它不受诸如“hoem”而不是“home”之类的拼写错误的影响。我认为，在长字符串的情况下，分数不太可能相同。您可以使用此函数代替直接比较。

【讨论】：

【解决方案2】：

要比较长度 > 255 的单元格值，您可以循环遍历范围，逐个单元格进行比较。

请阅读下面代码中的 cmets 了解更多详细信息，如有任何问题请回帖。

Option Explicit 'require declaration of ALL variables
   'go to Tools/Options/Editor and set "Require Variable Declaration"
Option Compare Text 'for case insensitive

Sub findDuplicates()

'Use Long instead of integer
'  Plenty of articles as to why
Const headRow As Long = 7 'row that contains the table heading row for the dataset
Dim lastRow As Long
Dim rng As Range
Dim Counter As Long
Dim V As Variant, I As Long, J As Long
Dim COLL As Collection


With ThisWorkbook.Worksheets(1)
    lastRow = .Range("F" & Rows.Count).End(xlUp).Row 'finds last row in dataset
    Set rng = .Range(Cells(headRow + 1, 6), Cells(lastRow, 6)) 'sets the range of the dataset between the headRow and lastRow
End With

'Read range into vba array for faster processing
V = rng

'loop through the array to do the count
Set COLL = New Collection 'collect the duplicate cell addresses
For I = 1 To UBound(V, 1)
    Counter = 0
    For J = 2 To UBound(V, 1)
        If V(J, 1) = V(I, 1) Then 'duplicate
            Counter = Counter + 1
            If Counter > 1 Then
                On Error Resume Next 'avoid duplicate addresses in the collection
                    COLL.Add Item:=rng(I).Address, Key:=rng(I).Address
                On Error GoTo 0
            End If
        End If
    Next J
Next I

'highlight the relevant cells
rng.Interior.ColorIndex = xlNone
For Each V In COLL
    Range(V).Interior.ColorIndex = 6
Next V

End Sub

【讨论】：