範圍內的唯一值

Question

我試圖編寫一個代碼，查看打開的工作表（figWkst），在F列中查找並收集所有唯一名稱，然後在一次添加一個唯一名稱後加上單詞「看守者「和一個逗號。因此，例如，如果列F中的唯一名稱是「紅色，白色，藍色，綠色」，則新工作表中的列R行n將顯示「紅色觀察者，白色觀察者，藍色觀察者，綠色觀察者「。我現在所擁有的只是在列R中顯示F行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 

Answer 1

這個怎麼樣...雖然這又是一個有點難以把握或模擬的真實情況......

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