Excel VBA - 행에서 중복 제거

Question

안녕하세요,

이전 게시물을 읽고이 특정 문제에 대한 답변을 찾을 수 없습니다.

내가 A2, B2로 값을 반환 엑셀의 VBA 스크립트를 가지고, C2는 다음 A3, B3, C3에 데이터를 채우기 위해 루프를 통해 실행 등 내가 중복 값을 제거하기 만하면 무엇

행에서 VBA를 사용하고 유일한 값만 반환합니다. 나는 "/"를 사용하여 구분합니다.

빈 셀을 무시해야합니다.

아이디어는 결과가 다음 루프 전에 계산된다는 것입니다.

이상적 I은 C1 등의 A1, B1,

이의 협조가 인정된다 채울 필요없이 결과를 표시 할 것이다.

'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 

결과 :