如何删除单元格字符串中的重复文本？

Question

所以想象一下excel的一个单元格中有以下字符串：

A1 = "Company 1 Company 2 Company 1 Company 2 Company 3"

现在想要的结果是删除重复项：

A1 = "Company 1 Company 2 Company 3"（我想这个不需要宏）

理想的做法是将不同的值以垂直方式放在不同的单元格中：

A1 = "Company 1"
A2 = "Company 2"
A3 = "Company 3"

（这肯定需要编程，但由于我从未使用过 vba，所以我没有足够的经验，我认为无法详细说明此类代码）

可行吗？

编辑：分隔符可以从空格“”更改为其他，例如分号“;”以防止错误并更容易解决这个问题。

Answer 1

假设你在字符串之间有一个分隔符来区分你可以使用以下代码

Option Explicit

Sub RemoveDuplicates()

Const SEPARATOR = ","
Dim vDat As Variant

    vDat = Split(Range("A1"), SEPARATOR)

    ' remove trailing blanks if necessary
    Dim i As Long
    For i = LBound(vDat) To UBound(vDat)
        vDat(i) = Trim(vDat(i))
    Next i

    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")

    Dim vItem As Variant

    For Each vItem In vDat
        If Not dic.Exists(vItem) Then
            dic.Add vItem, vItem
        End If
    Next

    vDat = dic.Keys

    ' Write data to column B
    Range("B1").Resize(UBound(vDat) + 1) = WorksheetFunction.Transpose(vDat)

    'Debug.Print Join(vDat, SEPARATOR)

End Sub

用以下数据测试

A1 = Company 1,  Company 2, Company 1, Company 2 , Company 3

或

A1 = IBM,  Apple, Microsoft, Apple , IBM

Answer 2

使用明确的字符串，我的意思是：

• 子字符串中不包含分隔符，或
• 每个条目都用双引号括起来

您可以在 Excel 2010、2013 中使用 Power Query 或在 Excel 2016 中使用 Data Get & Transform 来完成所有这些操作。

• 在分隔符上拆分单元格
  • 如有必要，将引号定义为文本限定符
• 行 - 删除重复项

所以数据如下：

Company 1;Company 2;Company 1;Company 2;Company 3

或（空格分隔符）

"Company 1" "Company 2" "Company 1" "Company 2" "Company 3"

您无需使用 VBA 即可轻松完成所需的工作。

如果，如您的示例中那样，数据的开头或结尾有多余的空格，Power Query 有一个有用的Text.Trim 函数。

Answer 3

使用 UDF 的替代解决方案（为清楚起见进行了注释）：

Public Function UNIQUELIST(ByVal arg_vOriginalList As String, ByVal arg_sDelimiter As String, ByVal arg_lReturnIndex As Long) As Variant

    Dim oDict As Object
    Dim vElement As Variant
    Dim i As Long

    'Use a dictionary to extract unique elements
    Set oDict = CreateObject("Scripting.Dictionary")
    i = 0   'This is a counter to keep track until we reach the appropriate return index

    'Loop through each element
    For Each vElement In Split(arg_vOriginalList, arg_sDelimiter)
        'Check the trimmed, lowercase element against the keys of the dictionary
        If Not oDict.Exists(LCase(Trim(vElement))) Then
            'Unique element found
            i = i + 1
            If i = arg_lReturnIndex Then
                'Found appropriate unique element, output and exit function
                UNIQUELIST = Trim(vElement)
                Exit Function
            End If

            'Not correct return index, add element to dictionary
            'Lowercase the key (so uniques aren't case sensitive) and trim both the key and the value
            oDict.Add LCase(Trim(vElement)), Trim(vElement)
        End If
    Next vElement

    'arg_lReturnIndex was less than 1 or greater than the number of unique values, return blank
    UNIQUELIST = vbNullString

End Function

然后在您希望输出开始的单元格中（例如，B1），输入此公式并复制下来（将"," 调整为正确的分隔符）：

=UNIQUELIST($A$1,",",ROW(A1))

Answer 4

使用与 OP 中相同的分隔符的方法

我假设与您的原始帖子中相同的空格分隔符：由于您希望将公司字符串分组为两个，我通过将Split 结果连接到第 2 步，稍微修改了 @Storax 的良好解决方案，并演示了一种将结果写回工作表的更短方法（参见第 [5] 节）。

示例代码

Option Explicit                ' declaration head of your code module

Sub SplitCompanies()
' [0] declare variables and set objects
  Dim v, vItem
  Dim i As Integer, n As Integer
  Dim s, str As String
  Dim ws As Worksheet
  Set ws = ThisWorkbook.Worksheets("Tabelle5")  ' << change to your sheet name
  Dim dict As Object                            ' late binding of dictionary
  Set dict = CreateObject("Scripting.Dictionary")
' [1] get cell value and split it (space delimited as in Original Post)
  str = ws.Range("A1")        ' cell value, e.g. "Company 1 Company 2 Company 1 Company 2 Company 3"
  s = Split(str, " ")         ' split cell value (space delimiter)
' [2] count all companies and redimension helper array
  n = Int((UBound(s) + 1) / 2) - 1    ' items counter equals 1/2 of split items
  ReDim v(0 To n)             ' redim zero-based 1-dim helper array
' [3] concatenate partial strings in helper array
  For i = 0 To n
    v(i) = s(i * 2) & " " & s(i * 2 + 1)
  Next i
' [4] build dictionary with unique items
  For Each vItem In v
    If Not dict.Exists(vItem) Then
        dict.Add vItem, vItem
    End If
  Next
' [5] Write data to column B
  ws.Range("B1:B" & dict.Count) = Application.Transpose(dict.Keys)
' [6] clear memory
  Set dict = Nothing: Set ws = Nothing
End Sub