Уникальные значения из диапазона

Я пытаюсь написать код, который смотрит на открытую таблицу (figWkst), выглядит в столбце F и собирает все уникальные имена, а затем добавляет одно уникальное имя за раз, за ​​которым следует слово «наблюдатель» и запятая.

Так, например, если уникальные имена в столбце F являются «Красный, Белый, Синий, Зеленый», то столбец R row n на новом листе отобразит «Красный Наблюдатель, Белый Наблюдатель, Синий Наблюдатель, Зеленый Наблюдатель». То, что у меня теперь отображается только в столбце R, отображается столбец F row n.

Я подумывал использовать словари, но, похоже, я не могу обмануть его. Любая помощь будет оценена! Спасибо. Вот мой код:

Sub Role() 'define variables Dim RoleWkb As Workbook, figWkb As Workbook, RoleWkst As Worksheet, figWkst As Worksheet Dim aCell As Long, a As Long, c As String, i As String, id As String, email As String, cityname As Variant 'open workbook fNameAndPath = Application.GetOpenFilename(Title:="Role Workbook") Set RoleWkb = Workbooks.Open(fNameAndPath) Set figWkb = ThisWorkbook Set RoleWkst = RoleWkb.Sheets("UserProfile") Set figWkst = figWkb.Worksheets("User Information") cityname = InputBox("City name?") 'adding watcher group aCell = figWkst.Range("D" & Rows.Count).End(xlUp).Row For a = 12 To aCell If figWkst.Cells(a, 17) = "x" Or figWkst.Cells(a, 17) = "X" Then If RoleWkst.Cells(a - 1, 18) <> "" Then RoleWkst.Cells(a - 1, 18) = Trim(RoleWkst.Cells(a - 1, 18) & ", " & cityname & " " & figWkst.Cells(a, 6) & " Watcher") Else RoleWkst.Cells(a - 1, 18) = Trim(cityname & " " & figWkst.Cells(a, 6) & " Watcher") End If End If Next a End Sub 

Как насчет этого … хотя снова немного сложно понять или смоделировать вашу реальную ситуацию …

 Sub RoleModified() 'define variables Dim RoleWkb As Workbook, figWkb As Workbook, RoleWkst As Worksheet, figWkst As Worksheet Dim aCell As Long, a As Long, c As String, i As String, id As String, email As String, cityname As Variant 'added some variables Dim vNames() 'to contain all the original names Dim vUniqueNames() 'to collect unique ones Dim vUniqueCount As Integer 'to count the unique ones Dim vUnique As Boolean 'to mark that it was stored already 'open workbook fNameAndPath = Application.GetOpenFilename(Title:="Role Workbook") Set RoleWkb = ThisWorkbook Set figWkb = ThisWorkbook Set RoleWkst = RoleWkb.Sheets("UserProfile") Set figWkst = figWkb.Worksheets("User Information") cityname = InputBox("City name?", , "London") 'whatever way you can refer to where the names are, this worked for my 'simulation... figWkst.Select vNames = Intersect(figWkst.UsedRange, Range("F:F")) 'set up the variables ReDim vUniqueNames(1 To UBound(vNames, 1)) vUniqueCount = 0 'loop through all the names and take each one only once For n = 1 To UBound(vNames, 1) vUnique = True 'test it against those already stored For m = 1 To UBound(vNames, 1) If vUniqueNames(m) = vNames(n, 1) Then vUnique = False End If Next m 'if not found, store it If vUnique Then vUniqueCount = vUniqueCount + 1 vUniqueNames(vUniqueCount) = vNames(n, 1) End If Next n 'placing unique names to the other sheet, meaning of x's missed For n = 1 To vUniqueCount RoleWkst.Cells(10 + n, 18) = cityname & " " & _ vUniqueNames(n) & " Watcher" Next n End Sub 
Давайте будем гением компьютера.