oobird

1. Sub yy()
   
2.     Dim d As Object, i%, r%, w$, s$, t, c As Range
   
3.     [a:c] = ""
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     For i = 6 To 10 Step 2
   
6.         For Each c In Cells(1, i).Resize(6, 2).SpecialCells(2)
   
7.             w = c.Value
   
8.             d(w) = d(w) + 1
   
9.         Next
   
10.         For Each t In d
    
11.             If d(t) = 1 Then d.Remove (t)
    
12.         Next
    
13.         If d.Count > 0 Then
    
14.             r = r + 1
    
15.             Cells(1, r).Resize(d.Count, 1) = Application.Transpose(d.keys)
    
16.             If s = "" Then s = Join(d.keys, "¡B") Else s = s & "¡B" & Join(d.keys, "¡B")
    
17.         End If
    
18.         d.RemoveAll
    
19.     Next
    
20.     [a7] = s
    
21. End Sub

½Æ»s¥N½X