劳动（我哪里做错了）

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 Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset)

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,",")

通过以下方法更改方法上的签名：

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

希望有帮助。

有没有一种方法可以简化此代码？该代码在3张纸上重复。

3 个答案:

劳动（我哪里做错了）

最终解决方案

错误1

错误2