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，我没有足够的经验，我认为要详细说明这些代码）

可行吗？

编辑：分隔符可以从空格＆＃34; ＆＃34;对其他人，例如，分号＆＃34;;＆＃34;防止错误并更容易解决这个错误。

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

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

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

您可以在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相同的分隔符

我假设与原始帖子中的相同的空格分隔符：因为您希望将您的公司字符串分为两个，我稍微修改了@Storax的良好解决方案，首先以{2}的步长连接Split结果，并演示了将结果写回工作表的更短方法（参见第[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

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

4 个答案: