Как найти дубликаты в одной ячейке и стереть один экземпляр в VBA - PullRequest
0 голосов
/ 11 февраля 2020

Отдельная программа, которую я не могу изменить, добавляет в электронную таблицу и иногда что-то дублирует.

Например: в ячейке 5 3

ABC, vbd, S19M-0027757-27760, S19M-0027757-27760(1)

или это может быть

ABC, vbd S19M-0027757-27760, S19M-0027757-27760(1)

Что мне нужно сделать, это заменить оба из них с S19M-0027757-27760 (1), поэтому результат будет:

ABC, vbd, S19M-0027757-27760(1)

Пока у меня есть:

For i = 5 To lRow
   inputArray = Split(Cells(i, 3).Value, " ")
   For j = 0 To (UBound(inputArray) - LBound(inputArray) - 1)
      Dim firstString As String
      Dim secondString As String
      firstString = inputArray(j)
      secondString = inputArray(j + 1)        
   Next
Next

Я думаю Следующим шагом будет сравнение букв за буквой? Но как насчет запятой и (1)?

Ответы [ 2 ]

1 голос
/ 11 февраля 2020

Попробуйте это. Возможно, недостаточно примеров, чтобы убедиться, что он будет работать во всех случаях, но короткий тест сработал.

Sub x()

Dim i As Long, inputArray, j As Long, outputArray(), k As Long

For i = 1 To 3
    inputArray = Split(Cells(i, 3).Value, ", ")
    For j = LBound(inputArray) To UBound(inputArray)
            k = k + 1
            ReDim Preserve outputArray(1 To k)
        If j = UBound(inputArray) - 1 Then
            If inputArray(j + 1) Like inputArray(j) & "(*)" Then
                outputArray(k) = inputArray(j + 1)
                Exit For
            Else
                outputArray(k) = inputArray(j)
            End If
        Else
            outputArray(k) = inputArray(j)
        End If
    Next j
    Cells(i, 4).Value = Join(outputArray, ", ")
    Erase outputArray: k = 0
Next i

End Sub

enter image description here

0 голосов
/ 11 февраля 2020

Другим способом, возможным через RegEx:

Sub Test()

Dim RegEx As Object: Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Global = True
RegEx.Pattern = "([A-Z0-9-]{18})(?=.+\1)"

Dim lr As Long, x As Long
With Sheet1
    lr = .Cells(.Rows.Count, 3).End(xlUp).Row
    For x = 5 To lr
        .Cells(x, 3).Value = Replace(Replace(RegEx.Replace(.Cells(x, 3).Value, ""), ", ,", ", "), " ,", ", ")
    Next x
End With

End Sub

Я согласен с @SJR, было бы здорово узнать еще несколько примеров, если бы RegEx.Pattern содержал TRUE. Теперь я придерживался предположений о 18-символьных моделях. Для текущих выборочных данных:

До:

enter image description here

После:

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...