VBA唯一值與工作表名稱一起計數

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