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

Question

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

“表 1”丹 2
“表 1”鲍勃 23
“Sheet1”标记 1
“Sheet2”禁令 3
“Sheet2”丹 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

Answer 1

此代码不使用字典，而是使用临时工作表和公式。
从每张纸上复制名称，删除重复项，然后是 COUNTIF应用公式进行计数。
然后复制最终数字并将值粘贴到临时表的 A 列中。

Sub Test()

    Dim wrkSht As Worksheet
    Dim tmpSht As Worksheet
    Dim rLastCell As Range
    Dim rTmpLastCell As Range
    Dim rLastCalculatedCell As Range

    'Add a temporary sheet to do calculations and store the list to be printed.
    Set tmpSht = ThisWorkbook.Worksheets.Add

   '''''''''''''''''''''''''''''''''''''''
   'Comment out the line above, and uncomment the next two lines
   'to print exclusively to the "Summary" sheet.
   '''''''''''''''''''''''''''''''''''''''
   'Set tmpSht = ThisWorkbook.Worksheets("Summary")
   'tmpSht.Cells.ClearContents

    For Each wrkSht In ThisWorkbook.Worksheets

        With wrkSht
            'Decide what to do with the sheet based on its name.
            Select Case .Name

                Case tmpSht.Name
                    'Do nothing
                Case Else 'Process sheet.

                    Set rLastCell = .Cells(.Rows.Count, 2).End(xlUp)
                    'tmpSht.Columns(4).Resize(, 3).ClearContents

                    'Copy names to temp sheet and remove duplicates.
                    .Range(.Cells(1, 2), rLastCell).Copy Destination:=tmpSht.Cells(1, 5)
                    tmpSht.Columns(5).RemoveDuplicates Columns:=1, Header:=xlNo

                    'Calculate how many names appear on the sheet and place sheet name
                    'to left of people names.
                    Set rTmpLastCell = tmpSht.Cells(Rows.Count, 5).End(xlUp)
                    tmpSht.Range(tmpSht.Cells(1, 5), rTmpLastCell).Offset(, 1).FormulaR1C1 = _
                        "=COUNTIF('" & wrkSht.Name & "'!R1C2:R" & rLastCell.Row & "C2,RC[-1])"
                    tmpSht.Range(tmpSht.Cells(1, 5), rTmpLastCell).Offset(, -1) = wrkSht.Name

                    'Find end of list to be printed.
                    Set rLastCalculatedCell = tmpSht.Cells(Rows.Count, 1).End(xlUp).Offset(1)

                    'Copy columns D:F which contain the sheet name, person name and count.
                    'Paste at the end of column A:C
                    tmpSht.Range(tmpSht.Cells(1, 4), rTmpLastCell).Resize(, 3).Copy
                    rLastCalculatedCell.PasteSpecial xlPasteValues

                    'Clear columns D:F
                    tmpSht.Columns(4).Resize(, 3).ClearContents

            End Select

        End With

    Next wrkSht

End Sub