如何切割字符串的一部分？

Question

我正在尝试从我拥有的字符串中删除重复项。

字符串如下所示：

word-1\word-2\word-3\word-3\word-3\word-3

我希望它看起来像这样：（没有重复）。

word-1\word-2\word-3

到目前为止，我想到了将字符串放入数组中并按 \ 拆分为项目。我真的不知道我应该如何减少重复。而且不知道重复了多少

这是我目前得到的：

Sub Split_and_remove()
  ' split items on \
  Dim item As String, newItem As String
  Dim items As Variant, newItems As Variant
  item = Sheet1.Range("A1").Value2
  items = Split(item, "\")
  newItems = items(0) + "\" + items(1) + "\" + items(2)
  Sheet1.Range("A4").Value2 = newItems
End Sub

谢谢！

Answer 1

通往罗马的更多道路：

FilterXML():

Sub tst()

Dim str1 As String, str2 As String

str1 = "word-1\word-2\word-3\word-3\word-3\word-3"
With Application
    str2 = Join(.Transpose(.FilterXML("<t><s>" & Replace(str1, "\", "</s><s>") & "</s></t>", "//s[not(preceding::*=.)]")), "\")
End With

End Sub

这需要 Excel2013 及更高版本。

字典：

更传统的做法是，我还会使用字典：

Sub tst()

Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim arr As Variant, x As Long
Dim str1 As String, str2 As String

str1 = "word-1\word-2\word-3\word-3\word-3\word-3"
arr = Split(str1, "\")

For x = LBound(arr) To UBound(arr)
    dict(arr(x)) = 1
Next
str2 = Join(dict.Keys, "\")

End Sub

Answer 2

这是一个带有集合的实现，因此您不需要像字典这样的外部对象：

Public Function GetUniqueValues(ByVal valueString As String, ByVal delimiter As String) As String
    With New Collection
        On Error Resume Next

        Dim item As Variant
        For Each item In Split(valueString, delimiter)
            .Add item, item

            If Err.Number = 0 Then _
                GetUniqueValues = GetUniqueValues & item & delimiter

            Err.Clear
        Next item
    End With

    GetUniqueValues = Left(GetUniqueValues, Len(GetUniqueValues) - Len(delimiter))
End Function

它可以与 VBA 的所有变体一起使用，而不仅仅是 Excel。

Answer 3

请尝试下一个功能：

Function elimDuplicates(x As String) As String
  Dim sh As Worksheet, arr
  
  Set sh = ActiveSheet
  arr = Split(x, "\")
  With sh.cells(1, ActiveSheet.UsedRange.Columns.count).Resize(UBound(arr) + 1, 1)
    .Value = Application.Transpose(arr)
    .RemoveDuplicates Columns:=1, Header:=xlNo
    arr = sh.Range(.cells(1, 1), sh.cells(sh.cells(rows.count, _
                    .Column).End(xlUp).row, .Column)).Value
    .Clear
  End With
  elimDuplicates = Join(Application.Transpose(Application.Index(arr, 0, 1)), "\")
End Function

可以这样测试：

Sub testElimDupl()
  MsgBox elimDuplicates("word-1\word-2\word-3\word-3\word-3\word-3")
End Sub

Answer 4

使用字典。

Sub Split_and_remove()

  Dim item As String, newItem As String
  Dim items As Variant, newItems As Variant
  
  item = Sheet1.Range("A1").Value2

  Sheet1.Range("A4").Value2 = getArray(item)
End Sub
Function getArray(s As String)
    Dim Dic As Object ' Dictionary
    Dim a As Variant, vArray As Variant

    Set Dic = CreateObject("Scripting.Dictionary")
    vArray = Split(s, "\")
    For Each a In vArray
        If Dic.Exists(a) Then
        Else
            Dic.Add a, a
        End If
    Next a
    getArray = Join(Dic.Keys, "\")
End Function

如何切割字符串的一部分？

How to cut a part of a string?

excel

vba

string

cut