有关如何将统计所有工作表相应单元格值得问题

阿智

非常感谢你在百忙之中抽空为我解答。
题目要求将所有工作表相应单元格的值按顺序放在一个单元格中，用逗号隔开，并统计它们出现的次数。
如附件所示。

liulang0808

Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    Set dd = CreateObject("scripting.dictionary")
    Application.ScreenUpdating = False
    For Each sh In Sheets
        If sh.Name <> "统计" Then
            arr = sh.[a1:r18]
            For j = 1 To UBound(arr)
                For i = 1 To UBound(arr, 2)
                    d(Cells(j, i).Address(0, 0)) = d(Cells(j, i).Address(0, 0)) & "," & arr(j, i)
                Next i
            Next j
        End If
    Next sh
    Sheets("统计").Select
    r = 0
    For Each k In d.keys
        r = r + 1
        arr = Split(d(k), ",")
        Cells(r, 13) = k
        Cells(r, 14) = Mid(d(k), 2)
        For j = 1 To UBound(arr)
            dd(arr(j)) = dd(arr(j)) + 1
        Next j
        For j = WorksheetFunction.Min(dd.items) To WorksheetFunction.Max(dd.items)
            str1 = ""
            For Each x In dd.keys
                If dd(x) = j Then
                    str1 = str1 & "," & Format(x, "00")
                End If
            Next x
            If Len(str1) > 0 Then
                r = r + 1
                Cells(r, 14) = "〖" & j & "次〗:" & Mid(str1, 2)
            End If
        Next j
    Next k
    Application.ScreenUpdating = True
End Sub

liulang0808

附件内容供参考，排序楼主可以自己搞

阿智

liulang0808 发表于 2021-3-9 07:11
附件内容供参考，排序楼主可以自己搞

非常感谢你的帮助，完美的解决了的问题。

阿智

liulang0808 发表于 2021-3-9 07:10
Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    Set dd = CreateObject("scri ...

非常感谢你的帮助，刚才在统计时无意发现一个小问题：统计的数次有点出入。所有的工作表加在一起不到200个，统计出来的次数中却超出了200次，不知道问题出在哪里？

liulang0808

字典清空看看。。。。

阿智

liulang0808 发表于 2021-3-9 13:00
字典清空看看。。。。

再次感谢你的耐心回复，问题解决了。谢谢。