拆分并移除重复项，然后重新加入
除以从列"N“中得到的值，我得到了这一点。唯一的问题是，不知怎么我无法删除重复的内容，然后用"，“将所有的内容重新连接起来。作为一名新手，我正在与数组做斗争，并且大多数情况下会出现“运行时错误13类型错配”。
我的输出如下：
strModel:第二排:丰田凡尔索09年-.(R2) 'strModel:第2行:丰田Verso‘09-.(R2) 'Model3:第3行：'strModel:第4行:丰田Avensis '97-'02 (T22) 'strModel:第4行:丰田Auris '07-'13 (E15) Model3:第5行：'Model3:第6行：- 'Model3:第7行：- 'Model3:第8行：- 'strModel:第9行:丰田RAV4 '05-'12 (A3) 'Model3:第10行：'Model3:第11行：'strModel:第12行:丰田Auris '07-'13 (E15) 'strModel:第13行:丰田Avensis‘97-02 (T22)
示例:来自"N“列的输入，第2行(=重复)：
Toyota /Toyota‘09- (R2)/Carrosserie/Grille;Toyota /Toyota’09-. (R2)/Overige
这就是我想要实现的输出：
strModel:第二排:丰田凡尔索09年-.(R2) 'Model3:第3行：- 'strModel:第4行:丰田Avensis‘97-02 (T22)，丰田Auris '07-'13 (E15) 'Model3:第5行：- 'Model3:第6行：'Model3:第7行：- 'Model3:第8行：'strModel:第9行:丰田RAV4 '05-'12 (A3) Model3:第10行：- 'Model3:第11行：- 'strModel:第12行:丰田Auris '07-'13 (E15) 'strModel:第13行:丰田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回答 1
Stack Overflow用户
发布于 2018-07-25 11:30:46
尝试添加一个字典，以帮助维护唯一性。
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
https://stackoverflow.com/questions/51515158
复制相似问题
腾讯云开发者
