Excel VBA - 突出显示重复的单元格值 - 段落(长字符串)

时间:2017-11-28 09:33:36

标签: excel vba countif

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

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

运行时错误'1004': 无法获取WorksheetFunction类的CountIf属性

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

<runtime>
  <AppContextSwitchOverrides value="Switch.System.IO.UseLegacyPathHandling=false;Switch.System.IO.BlockLongPaths=false" />
</runtime>

2 个答案:

答案 0 :(得分:0)

我建议将长文本转换为某个数值。看我的功能:

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值并返回分数。因为它是偶数乘以奇数的倍数,所以它会从错字符号中被删除,例如&#34; hoem&#34;而不是&#34; home&#34;。我认为,在长琴弦的情况下,得分不太可能相同。 您可以使用此功能代替直接比较。

答案 1 :(得分:0)

比较长度为&gt;的单元格值。 255,你可以循环遍历范围逐个细胞比较。

请阅读以下代码中的注释以获取更多详细信息,并回复任何问题。

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