Excel VBA - 消除連續的重複項

Question

晚上好，

我已閱讀以前的文章，並且找不到此特定問題的答案。

我在Excel中的VBA腳本返回值到A2，B2，C2它，然後通過一個循環運行，以數據填充到A3，B3，C3等

我需要做的就是消除重複值是什麼在使用VBA的行中並僅返回唯一值。我正在使用「/」分隔。

它需要忽略任何空白單元格。

這個想法是，結果是在下一個循環之前計算出來的。

理想我想，而不必填充A1，B1，C1等

你在這個協助理解僅顯示結果。

'Conditions 
    If Cells(rw, 24) = Cells(rw, 26) And Cells(rw, 24) = Cells(rw, 25) Then Cells(rw, 18) = "'" & Cells(rw, 24) 
    If Cells(rw, 24) <> Cells(rw, 26) Then Cells(rw, 18) = Cells(rw, 24) & "/" & Cells(rw, 26) 

    Cells(rw, 20) = Application.VLookup(Cells(rw, 18), Workbooks("CMF Export.xlsx").Sheets("Data").Columns("C:D"), 2, False) ' Vlookup function 
    If Not aCell Is Nothing Then 
Cells(rw, 23 + i) = Right(aCell.Value, 7) 
End If 

Answer 1

嘗試使用Collection存儲唯一值：

Sub test() 
    Dim col As Collection 
    Dim r As Range, c As Range 
    Dim res As String, lastrow As Long, el 
    'change sheet name to suit  
    With ThisWorkbook.Worksheets("Sheet1") 
     'Find last non empty row in column A 
     lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row 
     'add text format to column E 
     .Range("E2:E" & lastrow).NumberFormat = "@" 
     'iterates through each row 
     For Each r In .Range("A2:C" & lastrow).Rows   
      'initialize collection 
      Set col = New Collection 
      'iterates through each cell in row 
      For Each c In r.Cells 
       'next lines adds only unique values 
       On Error Resume Next 
       col.Add CStr(c.Value), CStr(c.Value) 
       On Error GoTo 0 
      Next     
      'collect result 
      res = "" 
      For Each el In col 
       res = res & el & "/" 
      Next        
      If res <> "" Then res = Left(res, Len(res) - 1) 
      'write result in column E 
      .Range("E" & r.Row).Value = res 
      'adding VLOOKUP (follow up from comments) 
      'With .Range("F" & r.Row) 
      'adjust Sheet1!A1:C100 to suit your needs 
      ' .Formula = "=VLOOKUP(" & res & ",Sheet1!A1:C100,3,0)" 
      'next line rewrites formula with formula result 
      ' .Value = .Value 
      'End With 
      Set col = Nothing 
     Next 
    End With 
End Sub 

結果：