Excel VBA 找出选定范围不重复值和重复值

Sub 找出选定范围内不重复的值() 

    On Error Resume Next 

   

    Dim d As Object 

    Set d = CreateObject("scripting.dictionary") 

    For c_i = 1 To selection.Columns.Count 

    For Each ce In selection.Columns(c_i).Cells 

        'd.Add ce.Value, 1 

        If ce <> "" Then 

            'D(ce.Value) = "" 

            If d.Exists(ce.Value) Then 

                d(ce.Value) = d(ce.Value) + 1 

            Else 

                d(ce.Value) = 1 

            End If 

        End If 

    Next 

    Next 

    'Debug.Print d.Count 

    If MsgBox("是否在邻列显示出现次数？", vbYesNo, "统计次数") = vbYes Then 

        标记 = True 

    End If 

    e = InputBox("希望在那个单元格下生成结果：", "结果输出", Chr(97 + selection.Columns(1).Cells(1).Column + 2) & selection.Columns(1).Cells(1).row) 

    m = Left(e, 1) 

    jj = Mid(e, 2, 1) 

    Range(m & jj) = "不重复值" 

    If 标记 = True Then 

        Range(Chr((Asc(m) + 1)) & jj) = "频率" '大于1的值 

    End If 

    For Each Key In d.Keys 

        Range(m & (jj + 1)) = Key 

        If 标记 = True Then 

'            If d(Key) > 1 Then Range(Chr((Asc(m) + 1)) & (jj + 1)) = d(Key) 

    Range(Chr((Asc(m) + 1)) & (jj + 1)) = d(Key) 

        End If 

        jj = jj + 1 

    Next 

    Set d = Nothing 

    '最后进行排序 

'     Range(m & selection.Columns(1).Cells(1).row & ":" & Chr((Asc(m) + 1)) & (jj)).Select 

    Range(e & ":" & Chr((Asc(m) + 1)) & (jj)).Sort Key1:=Range(m & Mid(e, 2, 1) + 1), Order1:=xlAscending, HEADER:=xlYes _ 

    , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 

    SortMethod:=xlPinYin, DataOption1:=xlSortNormal 

End Sub