我正在使用Excel,但有一个我无法解决的问题。
我在包含重复项的单元格中有数据,例如:
"Abraham/Beta/Abraham/Charlie"
我想删除第二个重复的“ Beta / Charlie”
有人有快捷方式如何快速执行此操作吗?当前,我正在手动遍历每个单元,这是很多工作。谢谢。
答案 0 :(得分:3)
这是一种解决方法。
Sub DeDupe()
Dim dict As Scripting.Dictionary, arr As Variant, rng As Range, cl As Range
Set rng = Range("A1:A10")
For Each cl In rng
arr = Split(cl, "/")
Set dict = New Scripting.Dictionary
For i = LBound(arr) To UBound(arr)
If Not dict.Exists(arr(i)) Then
dict.Add arr(i), arr(i)
End If
Next i
cl.Offset(0, 1) = Join(dict.Items, "/")
Next cl
End Sub
这是通过拆分/
上的数据,然后创建一个唯一值字典组成的字典,然后将它们结合在一起以创建重复数据删除的输出。
注意:
Microsoft Scripting Runtime
。参见Tools > References ...
A1:A10
中,而您希望输出在B1:B10
答案 1 :(得分:1)
通过Filter
函数的替代解决方案
除了@Alex P的有效答案之外,仅出于本领域的目的,我还演示了通过重复地过滤一个数据字段数组实现更快循环(无需使用字典)的方法:
示例代码
Sub DelDupes()
Dim i&, ii&, rng As Range
Dim v, arr ' Variant arrays
' [0] define data source range (omitting assumed title in 1st row)
Set rng = ThisWorkbook.Worksheets("MySheet").Range("A2:A10")
' [1] get 2-dim datafield array
v = rng ' create datafield array
' [2] loop through variant datafield array v
For i = LBound(v) To UBound(v)
arr = Split(v(i, 1), "/") ' create array from element i
' [3] check each string in arr
For ii = LBound(arr) To UBound(arr)
If ii > UBound(arr) Then Exit For ' escape condition
' more than 2 findings of current search string...
If UBound(Filter(arr, arr(ii), , vbTextCompare)) > 0 Then
' redefine array excluding found duplicates (i.e. make it smaller)
arr = Filter(arr, arr(ii), False, vbTextCompare)
ii = ii - 1 ' reduce string counter
End If
Next ii
' [4] remember row result
v(i, 1) = Join(arr, "/")
Next i
' [5] write adapted data back to sheet (e.g. into next column via offset 1)
rng.Offset(0, 1) = v
End Sub
注意事项
此解决方案还将找到的字符串部分视为重复的字符串!