Question

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

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

Answer 1

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

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

Answer 2

此代码不使用字典，而是使用临时工作表和公式。
从每个工作表中复制名称，删除重复项，然后应用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

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

2 个答案: