Как применить последнюю часть кода для всех листов

Question

Мне нужно применить последнюю часть моего кода ко всем листам, и мой код должен объединять повторяющиеся даты и суммировать его промежуточный итог.

Я только пробовал нажимать клавишу F5 для каждого из листов.

Sub CaseStudy()
Dim Rng As Range, Dn As Range
Dim nRng As Range
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    If Not .Exists(Dn.Value) Then
        .Add Dn.Value, Dn.Offset(, 1)
    Else
        .Item(Dn.Value).Value = .Item(Dn.Value).Value + Dn.Offset(, 1)
            If nRng Is Nothing Then
                Set nRng = Dn
            Else
                Set nRng = Union(nRng, Dn)
            End If
    End If
Next
If Not nRng Is Nothing Then nRng.EntireRow.Delete
End With
End Sub

Я хотел автоматически применить код ко всем листам.

Answer 1

«Разделяй и властвуй» - один из лучших способов построения кода. Таким образом, передайте каждый лист в Sub CaseStudy в качестве параметра.

Чтобы получить все рабочие листы, просмотрите коллекцию книг Worksheets:

Sub ApplyToAllSheets()

    Dim wks As Worksheet        
    For Each wks In ThisWorkbook.Worksheets
        CaseStudy wks
    Next

End Sub

Sub CaseStudy(wks As Worksheet)
    Dim Rng As Range, Dn As Range
    Dim nRng As Range
    With wks
        Set Rng = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp))
    End With

    With CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
    For Each Dn In Rng
        If Not .Exists(Dn.Value) Then
            .Add Dn.Value, Dn.Offset(, 1)
        Else
            .Item(Dn.Value).Value = .Item(Dn.Value).Value + Dn.Offset(, 1)
                If nRng Is Nothing Then
                    Set nRng = Dn
                Else
                    Set nRng = Union(nRng, Dn)
                End If
        End If
    Next
    If Not nRng Is Nothing Then nRng.EntireRow.Delete
    End With

End Sub