删除单元格中的重复单词

时间:2018-12-16 11:58:15

标签: excel vba

我正在使用Excel,但有一个我无法解决的问题。

我在包含重复项的单元格中有数据,例如:

"Abraham/Beta/Abraham/Charlie"

我想删除第二个重复的“ Beta / Charlie”

有人有快捷方式如何快速执行此操作吗?当前,我正在手动遍历每个单元,这是很多工作。谢谢。

2 个答案:

答案 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

这是通过拆分/上的数据,然后创建一个唯一值字典组成的字典,然后将它们结合在一起以创建重复数据删除的输出。

注意:

  1. 您需要引用Microsoft Scripting Runtime。参见Tools > References ...
  2. 这里假定您的数据在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

注意事项

此解决方案还将找到的字符串部分视为重复的字符串!