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

最新推荐文章于 2024-11-17 22:37:12 发布

转载最新推荐文章于 2024-11-17 22:37:12 发布 · 606 阅读

2 ·

CC 4.0 BY-SA版权

原文链接：http://www.cnblogs.com/zhanglei1371/p/6664817.html

本文介绍了一个VBA宏代码，用于在Excel中找出指定范围内的不重复值及其出现频率，并提供用户友好的交互界面，允许用户指定输出结果的位置。

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

转载于:https://www.cnblogs.com/zhanglei1371/p/6664817.html