不重复清单，不重复个数，在MSGBOX 显示

yunfei2018

   不重复清单，不重复个数，在MSGBOX 显示，附件：   不重复清单不重复个数在msgbox显示.zip (33.1 KB, 下载次数: 7)

2018-8-11 13:12 上传

点击文件名下载附件

   谢谢！

不知道为什么

用字典应可以。

山菊花

Sub 查看()
    Dim mRow As Long, i As Long, arr
    Dim dic As New Dictionary
    Dim Brr, Crr, cTxt$, nLen%
    With ActiveSheet
        mRow = .Range("AJ65536").End(3).Row
        If mRow < 3 Then Exit Sub
        arr = .Range("AG3:AJ" & mRow)
        For i = 1 To UBound(arr)
            If arr(i, 4) = "呆滞" Then
                dic(arr(i, 1)) = dic(arr(i, 1)) + 1
                If Len(arr(i, 1)) > nLen Then nLen = Len(arr(i, 1))
            End If
        Next
    End With
    Brr = dic.Keys
    Crr = dic.Items
    nLen = nLen + 1
    For i = 0 To UBound(Brr)
        cTxt = IIf(i = 0, "", cTxt & vbCrLf) & Brr(i) & String(nLen - Len(Brr(i)), "　") & " " & Crr(i)
    Next
    MsgBox cTxt, 48, "呆滞分类"
    Set dic = Nothing
End Sub

yunfei2018

山菊花 发表于 2018-8-11 17:26
Sub 查看()
    Dim mRow As Long, i As Long, arr
    Dim dic As New Dictionary

后面的数字，能否对齐显示？

就是说排版好看点，谢谢！

山菊花

已修改。