| 
    
     |  | ムーミン さん、INA さん、こんにちは。 
 色んな方法があると思いますが、ロジックとしては、
 
 1 重複なしのリストを作成(例題の1,3,6を見つけ出す)
 2 ↑リストに対して個数のカウント
 ですよね?
 '=========================================================
 Sub main()
 Dim e_row As Long
 Dim idx As Long
 Dim jdx As Long
 Dim r_add As String
 jdx = 1
 e_row = Cells(Rows.Count, 1).End(xlUp).Row
 r_add = Range(Cells(1, 1), Cells(e_row, 1)).Address
 For idx = 1 To e_row
 With WorksheetFunction
 If .CountIf(Range("a1:a" & idx), Range("a" & idx)) = 1 Then
 Range("b" & jdx).Value = Range("a" & idx).Value
 Range("c" & jdx).Formula = _
 "=countif(" & r_add & "," & Range("a" & idx).Value _
 & ")"
 jdx = jdx + 1
 End If
 End With
 Next
 End Sub
 
 アクティブシートに対してのコードです。
 確認してみて下さい。
 
 |  |