时间戳

首页 > 解决方案 > VBA 唯一值与工作表名称一起计数

vba - VBA 唯一值与工作表名称一起计数

问题描述

您好，我正在尝试浏览我的工作簿中的每张工作表，并打印工作表的名称以及每个唯一项目和它们的数量。但我收到一个错误，请帮忙。这是我试图达到的结果的一个广泛的例子，现在我已经注释掉了。

"Sheet1" Dan 2
"Sheet1" Bob 23
"Sheet1" Mark 1
"Sheet2" Ban 3
"Sheet2" Dan 2

我收到此行错误：

Sheets("Summary").Range(NextRowB).Resize(dict.Count - 1, 1).Value = ActiveSheet.Name

    Sub summaryReport()

    Dim dict As Object
    Set dict = CreateObject("scripting.dictionary")
    Dim varray As Variant, element As Variant

    For Each ws In ThisWorkbook.Worksheets


        varray = ActiveSheet.Range("B:B").Value


        'Generate unique list and count
         For Each element In varray

        If dict.exists(element) Then
            dict.Item(element) = dict.Item(element) + 1
        Else
            dict.Add element, 1
        End If

    Next

    NextRowB = Range("B" & Rows.Count).End(xlUp).Row + 1
    NextRowC = Range("C" & Rows.Count).End(xlUp).Row + 1
    Sheets("Summary").Range(NextRowB).Resize(dict.Count - 1, 1).Value=ActiveSheet.Name
    Sheets("Summary").Range(NextRowC).Resize(dict.Count, 1).Value = _WorksheetFunction.Transpose(dict.keys)
    'Sheets("Summary").Range("D3").Resize(dict.Count, 1).Value = _
    WorksheetFunction.Transpose(dict.items)

Next ws

End Sub

标签： vbaexcel

解决方案

我的代码为 Dictionary 中的每个键存储一个 ArrayList，以保存与该键关联的工作表名称列表。收集完所有数据后，它使用另一个 ArrayList 为每个键存储一个数组Array(Worksheet Name, Key Value, Count)。它将该 ArrayList 中的数据提取到一个 Array 中，该 Array 将写入摘要工作表。

Sub SummaryReport()
    Dim n As Long
    Dim dict As Object, list As Object, Target As Range, ws As Worksheet
    Set dict = CreateObject("Scripting.Dictionary")
    Dim key As Variant, keyWSName As Variant, data As Variant

    For Each ws In ThisWorkbook.Worksheets
        With ws
            If Not .Name = "Summary" Then
                Set Target = .Range("B2", .Range("B" & .Rows.Count).End(xlUp))
                If Not Target Is Nothing Then
                    For n = 1 To Target.Count
                        key = Target.Cells(1)
                        If Trim(key) <> "" Then
                            If Not dict.exists(key) Then
                                dict.Add key, CreateObject("System.Collections.ArrayList")
                            End If
                            dict(key).Add ws.Name
                        End If
                    Next

                End If
            End If
        End With
    Next ws

    Set list = CreateObject("System.Collections.ArrayList")
    For Each key In dict
        For Each keyWSName In dict(key)
            list.Add Array(keyWSName, key, dict(key).Count)
        Next
    Next

    ReDim data(1 To list.Count, 1 To 3)
    For n = 0 To list.Count - 1
        data(n + 1, 1) = list(n)(0)
        data(n + 1, 2) = list(n)(1)
        data(n + 1, 3) = list(n)(2)
    Next

    With ThisWorkbook.Worksheets("Summary")
        .Columns("B:D").ClearContents
        .Range("B2:D2").Resize(list.Count).Value = data
    End With

End Sub

推荐阅读