Изменение UDF-конкатенации для удаления дубликатов

Question

У меня есть пользовательский vlookup, который я хочу изменить, чтобы удалить дубликаты перед объединением. Это данные, которые я собрал. Я беру имена элементов из столбца A и удаляю дубликаты, чтобы создать уникальные данные для использования пользовательского Vlookup в столбце F.

В столбце F я использую эту функцию Excel: {=IFERROR(INDEX(A$2:A$12,MATCH(0,COUNTIF(F$1:F2,A$2:A$12),0)),"")}

Здесь я использую UDF, который выбирает код слева от него, а затем просматривает таблицу, чтобы найти имена функций, которые соответствуют , затем извлекая коды местоположений, которые нужно поместить в объединение, которое разделяет имена. Это то, что я имею в VBA для модуля.

`Function CusVlookup(FeatureName As String, pWorkRng As Range, pIndex As Long)
  Dim rng As Range
   Dim xResult As String
    xResult = ""
    For Each rng In pWorkRng
     If rng = FeatureName Then
     xResult = xResult & ", " & rng.Offset(0, pIndex - 1)
      If Left(xResult, 2) = ", " Then
      xResult = Mid(xResult, 2, 255)
   End If
  End If
  Next
  CusVlookup = xResult
  End Function`

Функция, используемая в ячейке G3, выглядит следующим образом: =cusvlookup(F3,A2:E12,5)

Это мой первый настоящий набег на VBA, и У меня был код, который я мог найти, просматривая поиски в Google и здесь. Все, что мне нужно, чтобы сделать этот код, это удалить повторяющиеся значения перед объединением, но объяснение того, что происходит, будет оценено.

Answer 1

Просто небольшое изменение в вашей функции. Обратите внимание, что диапазон ниже равен A2: A14 (не так, как A2: E12 в вашем коде). .. Для проверки функции INSTR VBA эта ссылка

Function CusVlookup(FeatureName As String, pWorkRng As Range, pIndex As Long)
Dim rng As Range
Dim xResult As String
xResult = ""

For Each rng In pWorkRng
    If rng = FeatureName And InStr(1, xResult, rng.Offset(0, pIndex - 1) & ",") = 0 Then
        If xResult = "" Then
        xResult = rng.Offset(0, pIndex - 1) & ", "
        Else
        xResult = xResult & rng.Offset(0, pIndex - 1) & ", "
        End If
    End If
Next

CusVlookup = Mid(xResult, 1, Len(xResult) - 2)
End Function

Вы можете перейти к следующей процедуре (отладка с помощью клавиши F8), чтобы понять, что происходит в вашей функции.

Sub test()
Dim FeatureName As String: FeatureName = Range("F3").Value
Dim pWorkRng As Range: Set pWorkRng = Range("A2:A12")
Dim pIndex As Long: pIndex = 5

Dim rng As Range
Dim xResult As String
xResult = ""

For Each rng In pWorkRng
    If rng = FeatureName And InStr(1, xResult, rng.Offset(0, pIndex - 1) & ",") = 0 Then
        If xResult = "" Then
        xResult = rng.Offset(0, pIndex - 1) & ", "
        Else
        xResult = xResult & rng.Offset(0, pIndex - 1) & ", "
        End If
    End If
Next

Debug.Print Mid(xResult, 1, Len(xResult) - 2)

End Sub