Question

我正在写一堆网址，而我正试图通过删除字符串中的重复字词来清理它们。问题是单词被斜杠和空格分隔（最终会变成破折号），这就是我撞墙的地方。以下是URL段的结构：

Beverages | Drinks      
Beverages | Drinks |    Chocolate Drinks    
Beverages | Drinks |    Chocolate Drinks |  Chocolate Milk

Beverages | Drinks |    Coffee  
Beverages | Drinks |    Coffee |    Iced Coffee

理想情况下，网址为：

/beverages/drinks
/beverages/drinks/chocolate
/beverages/drinks/chocolate/milk (the second chocolate removed).

/beverages/drinks/coffee
/beverages/drinks/coffee/iced

我用来将网段组合成网址的公式是：

=LOWER(M1 & IF(AND(M1<>"",N1 & O1<>""),"/","")& N1 & IF(AND(N1<>"",O1 & P1<>""),"/","") & O1 & IF(AND(O1<>"",P1<>""),"/","") & P1)

提前感谢您的帮助！

Answer 1

我假设你在一个单元格上拥有所有东西吗？

我建议你将它们分开，例如，如果给定的路径以 /饮料/饮料/....

你可以用空格替换空格然后用|分割字符串，这样你就可以操纵那个数组并构建你的路径了。如果至少将原始字符串拆分为2（常量 - ＆gt;饮料 - 饮料;以及变量），然后将我的代码调整为更好，那会更好。

Range("b1") = Application.WorksheetFunction.Clean(Range("a1"))
Range("b1") = Replace(Range("b1").Value, " ", "")
yourarray = Split(Range("b1").Value, "|")

让我知道它是否有效或您以不同的方式获取数据。

Answer 2

如果每个“部分”是一个单词，那么你可以处理每一行并删除重复的单词和额外的空格;然后用斜杠加入结果。但是，如果某些“部分”由两个单词组成（例如beverages | drinks | root beer，那么我们需要重新考虑算法。至少，您可能需要某种查找表来查找多字部分。 / p>

Option Explicit
Sub CondenseURLParts()
    Dim colParts As Collection
    Dim colURLs As Collection
    Dim vSrc As Variant, vRes() As Variant
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim I As Long, J As Long, K As Long
    Dim V1 As Variant, V2 As Variant

'Set source data and results worksheets and range
Set wsSrc = Worksheets("Sheet1")
Set wsRes = Worksheets("Sheet1")
    Set rRes = wsRes.Cells(1, 2)

'Get original data
With wsSrc
    vSrc = Range(.Cells(1, 1), .Cells(.Rows.Count, "A").End(xlUp))
End With

'Process each line and collect unduplicated parts
Set colURLs = New Collection
For I = 1 To UBound(vSrc)
    V1 = Split(vSrc(I, 1), "|")
    If UBound(V1) <> -1 Then
        On Error Resume Next
        Set colParts = New Collection
            For J = 0 To UBound(V1)
                V2 = Split(WorksheetFunction.Trim(V1(J)))
                For K = 0 To UBound(V2)
                    colParts.Add V2(K), CStr(V2(K))
                Next K
            Next J
        On Error GoTo 0
        colURLs.Add colParts
    End If
Next I

'Create Results array
ReDim vRes(0 To colURLs.Count, 1 To 1)
vRes(0, 1) = "URL Parts"
For I = 1 To UBound(vRes)
    ReDim V1(1 To colURLs(I).Count)
        For J = 1 To UBound(V1)
            V1(J) = colURLs(I)(J)
        Next J
    vRes(I, 1) = "/" & Join(V1, "/")
Next I

'Write the results
Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
    .EntireColumn.Clear
    .Value = vRes
    With .Rows(1)
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    .EntireColumn.AutoFit
End With

End Sub

在Excel中的字符串或跨列中重复删除

2 个答案: