我希望让我的生活更轻松,并编写一个脚本来搜索并突出显示Excel中的重复值。
例如,我有2行具有复杂值的行。 First Row不是那么重要,因为它只是一个名字,但第二行很重要,在这里我无法弄清楚如何搜索重复项。一个重要的事情是,谷值是相同的,但它有时可能有不同的写法。
请你帮帮我,我仍然手动搜索,2小时后我失去了视力和心灵:)
答案 0 :(得分:1)
你可以利用:
SortedList
对象,用于创建代码密钥,该密钥独立于每个“代码”单元格中的“值”出现顺序
Dictionary
对象,收集对应相同代码的所有“人”密钥
如下:
Option Explicit
Sub main()
Dim iRow As Long
Dim codeKey As Variant, persons As Variant
Dim codesRng As Range
Set codesRng = Range("C3", Cells(Rows.count, 3).End(xlUp)) '<--| set the range with all codes
Normalize codesRng '<--| rewrite codes with only one delimiter
With CreateObject("Scripting.Dictionary") '<--| instantiate a 'Dictionary' object
For iRow = 1 To codesRng.Rows.count '<--| loop through 'codesRng' cells
codeKey = GetKey(codesRng(iRow, 1)) '<--| get its "Key"
.item(codeKey) = .item(codeKey) & codesRng(iRow, 1).Offset(, -2) & "|" '<--| update current 'codeKey' dictionary item with the corresponding "person"
Next
For Each codeKey In .Keys '<--| loop through dictionary keys
persons = Split(Left(.item(codeKey), Len(.item(codeKey)) - 1), "|") '<--| get current key array of "persons"
If UBound(persons) > 0 Then Debug.Print Join(persons, ",") '<--| print them if more than one person
Next
End With '<--| release 'Dictionary' object
End Sub
Sub Normalize(rng As Range)
With rng
.Replace " ", "", xlPart
.Replace "+-", "+", xlPart
.Replace "(", "", xlPart
.Replace ")", "", xlPart
.Replace "/", "+", xlPart
.Replace "+Ax", "Ax", xlPart
.Replace "+", "|", xlPart
End With
End Sub
Function GetKey(strng As String) As Variant
Dim elements As Variant
Dim j As Long
elements = Split(strng, "|") '<--| get an array of values out of those found delimited by a pipe ("|") in the string
With CreateObject("System.Collections.SortedList") '<--| instantiate a 'SortedList' object
For j = 0 To UBound(elements) '<--| loop through array values
.item(CStr(elements(j))) = "" '<--| add them to 'SortedList' object
Next
For j = 0 To .count - 1 '<--| iterate through 'SortedList' object elements
elements(j) = .GetKey(j) '<--| write back array values in sorted order
Next
End With '<--| release 'SortedList' object
GetKey = Join(elements, "|") '<--| return the "Key" as a string obtained from the passed one sorted values
End Function
答案 1 :(得分:0)
可能有助于以
开头的示例代码Sub same()
Dim a$(), i%, i1%, i2%, j%, r$, s As Boolean, w$, k, t$, dict As Object, c$
Set dict = CreateObject("scripting.dictionary")
i = 1
While Cells(i, 3) <> ""
' first split string into multiple strings
j = 0
r = Cells(i, 3)
For i1 = 1 To Len(r)
c = Mid(r, i1, 1)
Select Case c
Case "+", "-", "/", "(", ")"
s = True
Case Else
w = w & c
End Select
If s = True Or i1 = Len(r) Then
If w <> "" Then
j = j + 1
ReDim Preserve a(j)
a(j) = w
w = ""
s = False
End If
End If
Next i1
' sort the strings in ascending order
k = 0
For i1 = 1 To j - 1
k = i1
For i2 = i1 + 1 To j
If a(i2) < a(k) Then k = i2
Next i2
t = a(i1): a(i1) = a(k): a(k) = t
Next i1
' detect if doublons using a dictionary
k = Join(a, "-")
If dict.exists(k) Then 'doublon detected
Cells(i, 4) = dict.Item(k)
Cells(dict.Item(k), 4) = Cells(dict.Item(k), 4) & " " & i
Else
dict.Add k, i
End If
i = i + 1
Wend
End Sub
答案 2 :(得分:0)
基于您的示例#user3598756 我添加了这个单独的模块,我可以看到颜色的重复,这是非常有帮助的
Sub Find_Duplicate_Entry()
Dim cel As Variant
Dim myrng As Range
Dim clr As Long
Set myrng = Range("O4:O" & Range("O65536").End(xlUp).Row)
myrng.Interior.ColorIndex = xlNone
clr = 3
For Each cel In myrng
If Application.WorksheetFunction.CountIf(myrng, cel) > 1 Then
If WorksheetFunction.CountIf(Range("O2:O" & cel.Row), cel) = 1 Then
cel.Interior.ColorIndex = clr
clr = clr + 1
Else
cel.Interior.ColorIndex = myrng.Cells(WorksheetFunction.Match(cel.Value, myrng, False), 1).Interior.ColorIndex
End If
End If
Next
End Sub
现在唯一的问题是代码切换位置时。
示例:
(的 A302x / A402x 强> / A6U8x)+(A235x / A3ARx)
(的 A402x / A302x 强> / A6U8x)+(A235x / A3ARx)
Excel看不到重复,但对于我的情况,它是一个错误