怎样统计多工作表D列相同单元格及相同单元格出现的次数？（已解决）

jscsj

统计D列有哪些相同单元格及相同单元格个数将结果汇总到一个新工作表中
列标题为工作表名
行标题为D列中的单元格，一个相同的单元格为一行标题
（比如P2工作表的D列，Oulu一共出现了18次，则Oulu为行标题，18为Oulu行p2列的数据）


请教各位高手！

山菊花

供参考。

3190496160

重复次数是需要按每个工作表统计，还是所有的工作表统计？？？？？

3190496160

Sub 统计()
Dim d As Object
Dim ar As Variant
Dim br()
Dim i As Long
Dim sh As Worksheet
Set d = CreateObject("scripting.dictionary")
ReDim br(1 To 10000, 1 To 2)
For Each sh In Sheets
    If sh.Name <> "统计" Then
        r = sh.Cells(Rows.Count, 4).End(xlUp).Row
        ar = sh.Range("d1:d" & r)
        For i = 2 To UBound(ar)
            If Trim(ar(i, 1)) <> "" Then
                t = d(Trim(ar(i, 1)))
                If t = "" Then
                    k = k + 1
                    d(Trim(ar(i, 1))) = k
                    t = k
                    br(k, 1) = ar(i, 1)
                End If
                br(t, 2) = br(t, 2) + 1
            End If
        Next i
    End If
Next sh
With Sheets("统计")
    .[a1].CurrentRegion.Offset(1) = Empty
    .[a2].Resize(k, 2) = br
End With
MsgBox "ok!", 64, "3190496160 提醒"
End Sub

3190496160

目前的代码是统计所有工作表的重复次数
对C列分类计数.rar (576.48 KB, 下载次数: 5)

2021-5-11 08:31 上传

点击文件名下载附件

jscsj

3190496160 发表于 2021-5-11 08:29
重复次数是需要按每个工作表统计，还是所有的工作表统计？？？？？

我没有表达清楚
是对所有工作表分别进行统计，每个工作表为一列，列标题为工作表名

3190496160

Sub 统计()
Dim d As Object
Dim ar As Variant
Dim br()
Dim i As Long
Dim sh As Worksheet
Set d = CreateObject("scripting.dictionary")
ReDim br(1 To 10000, 1 To Sheets.Count)
m = 1: k = 1
For Each sh In Sheets
    If sh.Name <> "统计" Then
        r = sh.Cells(Rows.Count, 4).End(xlUp).Row
        m = m + 1
        br(1, m) = sh.Name
        ar = sh.Range("d1:d" & r)
        For i = 2 To UBound(ar)
            If Trim(ar(i, 1)) <> "" Then
                t = d(Trim(ar(i, 1)))
                If t = "" Then
                    k = k + 1
                    d(Trim(ar(i, 1))) = k
                    t = k
                    br(k, 1) = ar(i, 1)
                End If
                br(t, m) = br(t, m) + 1
            End If
        Next i
    End If
Next sh
With Sheets("统计")
    .[a1].CurrentRegion = Empty
    .[a1].Resize(k, UBound(br, 2)) = br
End With
MsgBox "ok!", 64, "3190496160 提醒"
End Sub

3190496160

对C列分类计数.rar (574.15 KB, 下载次数: 8)

2021-5-11 09:28 上传

点击文件名下载附件

jscsj

3190496160 发表于 2021-5-11 09:28

正是我想要的，非常感谢！

jscsj

山菊花 发表于 2021-5-11 08:26
供参考。

感谢又一次出手相帮，数据都出来了。这种排列也行！
按8楼的排列，就是我想要的结果。