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