Есть ли способ упростить этот код?Код повторяется на 3 листах.

Question

Мне нужен код для цикла для указанных листов.Текущий код работает, но мне пришлось скопировать и вставить код и установить каждый лист, на котором я хотел, чтобы код работал как активный лист

У меня был код, прикрепленный к кнопке на 3 разных листах, и код былустановить на активный лист и должен был перейти на каждый лист и нажать кнопку.Я хотел, чтобы одна кнопка управляла всеми 3 кнопками или запускала код на 3 листах.ниже было мое решение.Может ли это быть зациклено для названных листов (труд подрядчика, материал и труд компании)?

Private Sub Update_Click()
Application.ScreenUpdating = False
Sheets("Contractor Labor Summary").Activate
ActiveSheet.Columns(1).ClearContents
ActiveSheet.Range("A2").Value = "Project"
ActiveSheet.Range("A3").Select
Dim sh As Worksheet
Dim cell As Range
For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> "Material Summary" And sh.Name <> "Company Labor" And sh.Name <> "Contractor Labor Summary" And sh.Name <> "Forecast" Then
        ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'" & sh.Name & "'" & "!A1", TextToDisplay:=sh.Name
        ActiveCell.Offset(1, 0).Select
    End If
Next sh

Sheets("Material Summary").Activate
ActiveSheet.Columns(1).ClearContents
ActiveSheet.Range("A2").Value = "Project"
ActiveSheet.Range("A3").Select
For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> "Material Summary" And sh.Name <> "Company Labor" And sh.Name <> "Contractor Labor Summary" And sh.Name <> "Forecast" Then
        ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'" & sh.Name & "'" & "!A1", TextToDisplay:=sh.Name
        ActiveCell.Offset(1, 0).Select
    End If
Next sh

Sheets("Company Labor").Activate
ActiveSheet.Columns(1).ClearContents
ActiveSheet.Range("A2").Value = "Project"
ActiveSheet.Range("A3").Select
For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> "Material Summary" And sh.Name <> "Company Labor" And sh.Name <> "Contractor Labor Summary" And sh.Name <> "Forecast" Then
        ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'" & sh.Name & "'" & "!A1", TextToDisplay:=sh.Name
        ActiveCell.Offset(1, 0).Select
    End If
Next sh
Application.ScreenUpdating = True
End Sub

Если есть что-то, что можно изменить, чтобы сделать код более чистым, обратная связь приветствуется.

Answer 1

Труд (Куда я пошёл не так)

Что кто-то делает, когда что-то неясно (см. «Неправильно 1 и Неправильно 2» ниже).

Окончательное решение

Private Sub Update_Click()

    Const cStrSheets As String = "Contractor Labor Summary," _
        & "Material Summary,Company Labor,Forecast"   ' Worksheet List

    Dim sh As Worksheet       ' Worksheet For-Each Control Variable
    Dim vntSheets As Variant  ' Worksheet Array
    Dim i As Integer          ' Worksheet Counter
    Dim j As Integer          ' Cells Counter

    Application.ScreenUpdating = False

    ' Split Worksheet List into Worksheet Array
    vntSheets = Split(cStrSheets, ",")

    ' Loop through Worksheet Array, the last is needed in the next If statement.
    For i = 0 To UBound(vntSheets) - 1

        With Worksheets(vntSheets(i))

            .Columns(1).ClearContents
            .Range("A2").Value = "Project"

            ' Insert hyperlinks linking to other worksheets (sh), not contained in
            ' Worksheet Array (vntSheets), one below the other (j).
            j = 0
            For Each sh In Worksheets
                If sh.Name <> vntSheets(0) And sh.Name <> vntSheets(1) And _
                        sh.Name <> vntSheets(2) And sh.Name <> vntSheets(3) Then
                    .Hyperlinks.Add Anchor:=.Range("A" & CStr(3 + j)), _
                            Address:="", SubAddress:="'" & sh.Name & "'" _
                            & "!A1", TextToDisplay:=sh.Name
                    j = j + 1
                End If
            Next

        End With

    Next

    Application.ScreenUpdating = True

End Sub

Неверно 1

Private Sub Update_Click()

    Const cStrSheets As String = "Contractor Labor Summary, " _
        & "Material Summary, Company Labor"

    Dim vntSheets As Variant
    Dim i As Integer

    Application.ScreenUpdating = False

    vntSheets = Split(cStrSheets, ",")

    For i = 0 To UBound(vntSheets)
        With Worksheets(Trim(vntSheets(i)))
            .Columns(1).ClearContents
            .Range("A2").Value = "Project"
            .Hyperlinks.Add Anchor:=.Range("A3"), Address:="", _
                    SubAddress:="'" & .Name & "'" & "!A1", _
                    TextToDisplay:=.Name
            .Range("A4").Select
        End With
    Next

    Application.ScreenUpdating = True

End Sub

Неверно 2

Private Sub Update_Click()

    Const cStrSheets As String = "Contractor Labor Summary, " _
        & "Material Summary, Company Labor, Forecast"

    Dim sh As Worksheet
    Dim vntSheets As Variant
    Dim i As Integer

    Application.ScreenUpdating = False

    vntSheets = Split(cStrSheets, ",")

    For i = 0 To UBound(vntSheets)
        For Each sh In Worksheets
            With sh
                If .Name <> vntSheets(0) And .Name <> vntSheets(1) And _
                        .Name <> vntSheets(2) And .Name <> vntSheets(3) Then
                    .Columns(1).ClearContents
                    .Range("A2").Value = "Project"
                    .Hyperlinks.Add Anchor:=.Range("A" & i + 3), Address:="", _
                            SubAddress:="'" & Trim(vntSheets(i)) _
                            & "'" & "!A1", TextToDisplay:=Trim(vntSheets(i))
                End If
            End With
        Next
    Next

    'ActiveWorkbook.Save

    Application.ScreenUpdating = True

End Sub

Answer 2

Передача массива имен рабочих листов в рабочие таблицы вернет массив листов, по которым вы можете выполнить итерацию.

 For Each ws In ActiveWorkbook.Worksheets(Array("Contractor Labor Summary", "Material Summary", "Company Labor"))

Избегать выбора или активации объектов.Лучше всего обращаться к ячейкам напрямую.

Введение в Excel VBA, часть 5. Выбор ячеек (диапазон, ячейки, Activecell, конец, смещение)

Private Sub Update_Click()
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Dim sh As Worksheet
    Dim n As Long

    For Each ws In ActiveWorkbook.Worksheets(Array("Contractor Labor Summary", "Material Summary", "Company Labor"))
        Dim cell As Range
        ws.Columns(1).ClearContents
        ws.Range("A2").Value = "Project"
        n = 0
        For Each sh In ActiveWorkbook.Worksheets
            If sh.Name <> "Material Summary" And sh.Name <> "Company Labor" And sh.Name <> "Contractor Labor Summary" And sh.Name <> "Forecast" Then
                ws.Hyperlinks.Add Anchor:=ws.Range("A3").Offset(n), Address:="", SubAddress:="'" & sh.Name & "'" & "!A1", TextToDisplay:=sh.Name
                n = n + 1
            End If
        Next sh
    Next

    Application.ScreenUpdating = True
End Sub

Answer 3

Поскольку ваш основной код повторяется, вы можете создать для него отдельный метод, а затем, перебирая листы, установить объект листа на лист, а затем применить код.

Точнее,Вы могли бы создать массив имен листов, затем зациклить массив, назначив каждому объекту листа и затем вызывая код на нем.

Я не стал внимательно изучать ваш код, но выможет потребоваться обобщить и абстрагировать ваш код немного больше, но общее правило верно.

Sub foo()

    Dim wks As Worksheet
    For Each wks In ThisWorkbook.Worksheets

        '''call to common method goes here 
        If... (sheet name matches one of several
            commonMethod(wks)
        End Iif 

    Next wks

End Sub

Sub commonMethod(wks As Worksheet)

    Dim sh As Worksheet
    Dim cell As Range

    wks.Activate
    wks.ClearContents
    wks.Range("A2").Value = "Project"
    wks.Range("A3").Select
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> "Material Summary" And sh.Name <> "Company Labor" And     sh.Name <> "Contractor Labor Summary" And sh.Name <> "Forecast" Then
            ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'" & sh.Name & "'" & "!A1", TextToDisplay:=sh.Name
        ActiveCell.Offset(1, 0).Select
        End If
    Next sh
End Sub

Как создать и выполнить итерацию массива:

''create string of sheets
Dim cStrSheets As String = "Contractor Labor Summary," _
    & "Material Summary,Company Labor,Forecast"   ' Worksheet List

''creates array from string
Dim arrSheets as variant = sp,it(cstrSheets,",")

Изменить подпись наметод th следующий:

Sub commonMethod(wks As Worksheet, arrSheets as variant)

Чтобы заменить эту строку:

If sh.Name <> "Material Summary" And sh.Name <> "Company Labor" And sh.Name <> "Contractor Labor Summary" And sh.Name <> "Forecast"

Вы можете использовать что-то вроде этого:

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

Новая строка будет:

If IsInArray(sh.Name, arrSheets) = false then

Надеюсь, это поможет.