Question

到目前为止，我已经拆分了从“ N”列中获得的值。唯一的事情是，我以某种方式无法删除重复项，然后用“，”将所有内容重新连接在一起。作为一个新手，我在数组上苦苦挣扎，并且大多会遇到“运行时错误13 –类型不匹配”。

我的输出如下：

'strModel:          Row 2: Toyota Verso '09-... (R2)
'strModel:          Row 2: Toyota Verso '09-... (R2)
'Model3:            ROW 3: -
'strModel:          Row 4: Toyota Avensis '97-'02 (T22)
'strModel:          Row 4: Toyota Auris '07-'13 (E15)
'Model3:            ROW 5: -
'Model3:            ROW 6: -
'Model3:            ROW 7: -
'Model3:            ROW 8: -
'strModel:          Row 9: Toyota RAV4 '05-'12 (A3)
'Model3:            ROW 10: -
'Model3:            ROW 11: -
'strModel:          Row 12: Toyota Auris '07-'13 (E15)
'strModel:          Row 13: Toyota Avensis '97-'02 (T22)

示例：来自第2列“ N”的输入（=重复）：

Toyota Verso / Toyota Verso '09 -...（R2）/ Carrosserie / Grille; Toyota Verso / Toyota Verso '09 -...（R2）/ Overige

这是我要实现的输出：

'strModel:          Row 2: Toyota Verso '09-... (R2)
'Model3:            ROW 3: -
'strModel:          Row 4: Toyota Avensis '97-'02 (T22), Toyota Auris '07-'13 (E15)
'Model3:            ROW 5: -
'Model3:            ROW 6: -
'Model3:            ROW 7: -
'Model3:            ROW 8: -
'strModel:          Row 9: Toyota RAV4 '05-'12 (A3)
'Model3:            ROW 10: -
'Model3:            ROW 11: -
'strModel:          Row 12: Toyota Auris '07-'13 (E15)
'strModel:          Row 13: Toyota Avensis '97-'02 (T22)

这是我现在拥有的工作代码：

    Option Explicit

    Sub Sample()

    Dim oWS As Worksheet
    Dim fill As String
    Dim x As Long
    Dim i As Long
    Dim strMODEL As String
    Dim strMODELS() As String
    Dim Model2 As Variant
    Dim Model3 As Variant
    Dim myElements() As String
    Dim myString As String
    Dim LastRow As Long

    Set oWS = Sheets("Sheet1")
    LastRow = oWS.Range("A" & Rows.Count).End(xlUp).Row
    fill = "-"

    For i = 2 To LastRow

        myString = oWS.Cells(i, "N")                                                 ' MODEL
        strMODELS = Split(myString, ";")                                         ' ----- SPLIT 1 -----

        If Len(myString) > 1 Then

            For Each Model2 In strMODELS
                        strMODEL = Split(Model2, "/")(1)                        ' ----- SPLIT 2 -----  2nd Element Of Array
                                    Debug.Print ("strModel:          ROW ") & i & ": " & strMODEL

          '*****************************************************
          ' 1) Remove duplicates from strMODEL
          ' 2) Join everything back separated by ","
          '*****************************************************

                        Next Model2
             Else
                        Model3 = fill
                                    Debug.Print ("Model3:             ROW ") & i & ": " & fill
             End If
    Next i
    End Sub

Answer 1

尝试添加词典以帮助保持唯一性。

Option Explicit

Sub Sample()
    Dim i As Long, arr As Variant, tmp As Variant, str As String
    Dim dict As Object

    Set dict = CreateObject("scripting.dictionary")

    With Worksheets("sheet1")
        arr = .Range(.Cells(2, "N"), .Cells(.Rows.Count, "N").End(xlUp)).Value2

        For i = LBound(arr, 1) To UBound(arr, 1)
            tmp = Split(arr(i, 1), ":", 3)
            str = Join(Array(tmp(0), tmp(1), Space(1)), ":")
            If dict.exists(str) Then
                dict.Item(str) = dict.Item(str) & ", " & Trim(tmp(2))
            Else
                dict.Item(str) = Trim(tmp(2))
            End If
        Next i

        ReDim arr(1 To dict.Count, 1 To 1)
        i = LBound(arr, 1)

        For Each tmp In dict.keys
            arr(i, 1) = tmp & dict.Item(tmp)
            i = i + 1
        Next tmp

        .Cells(2, "O").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    End With
End Sub

拆分并删除重复项，然后重新加入

1 个答案: