如何修改VBA代码实现遍历多工作表后返回首个工作表

问题描述 #

我编写了LabelSet宏，可遍历工作簿中的13个工作表，设置薪资周期起止日期相关的单元格格式与内容，但执行完成后会停留在最后一个工作表。现附上现有代码，希望能修改代码使其遍历结束后返回第一个工作表。

现有代码 #

Sub LabelSet()
Dim xWkSheet As Worksheet
Dim StrWkName As String
Dim xString As String
Dim i As Integer
Dim SDate As Variant
Dim EDate As Variant

SDate = InputBox("Enter Next Pay Period Start Date (mm/dd/yyyy")
If Not IsDate(SDate) Then End
EDate = InputBox("Enter Next Pay Period End Date (mm/dd/yyyy")
If Not IsDate(EDate) Then End

For Each xWkSheet In ThisWorkbook.Worksheets
    StrWkName = xWkSheet.Name
    With xWkSheet.Range("H6:J6")
        .Merge Across:=True
        .Interior.ColorIndex = 35
        .Borders.LineStyle = xlContinous
        .Borders.LineStyle = xlThick
        .Value = "Next Pay Period Starts"
    End With
    With xWkSheet.Range("H7:J7")
        .Merge Across:=True
        .Interior.ColorIndex = 40
        .Borders.LineStyle = xlContinous
        .Borders.LineStyle = xlThick
        .Value = "Next Pay Period Ends"
    End With
    With xWkSheet.Range("K6")
        .Interior.ColorIndex = 35
        .Borders.LineStyle = xlContinous
        .Borders.LineStyle = xlThick
        .Font.ColorIndex = 3
        .Font.Bold = True
        .Value = SDate
     End With
    With xWkSheet.Range("K7")
        .Interior.ColorIndex = 40
        .Borders.LineStyle = xlContinous
        .Borders.LineStyle = xlThick
        .Font.ColorIndex = 3
        .Font.Bold = True
        .Value = EDate
     End With
   Next

' need to return to the first worksheet

end sub

修改方案 #

在循环结束后添加激活第一个工作表的代码即可。另外注意原代码中xlContinous是拼写错误，正确应为xlContinuous，且重复设置LineStyle会覆盖连续边框样式，需调整为设置边框粗细，否则边框样式设置会失效。

修改后的完整代码 #

Sub LabelSet()
Dim xWkSheet As Worksheet
Dim StrWkName As String
Dim xString As String
Dim i As Integer
Dim SDate As Variant
Dim EDate As Variant

SDate = InputBox("请输入下一个薪资周期开始日期 (mm/dd/yyyy)")
If Not IsDate(SDate) Then Exit Sub
EDate = InputBox("请输入下一个薪资周期结束日期 (mm/dd/yyyy)")
If Not IsDate(EDate) Then Exit Sub

For Each xWkSheet In ThisWorkbook.Worksheets
    StrWkName = xWkSheet.Name
    With xWkSheet.Range("H6:J6")
        .Merge Across:=True
        .Interior.ColorIndex = 35
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThick
        .Value = "下一个薪资周期开始"
    End With
    With xWkSheet.Range("H7:J7")
        .Merge Across:=True
        .Interior.ColorIndex = 40
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThick
        .Value = "下一个薪资周期结束"
    End With
    With xWkSheet.Range("K6")
        .Interior.ColorIndex = 35
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThick
        .Font.ColorIndex = 3
        .Font.Bold = True
        .Value = SDate
     End With
    With xWkSheet.Range("K7")
        .Interior.ColorIndex = 40
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThick
        .Font.ColorIndex = 3
        .Font.Bold = True
        .Value = EDate
     End With
   Next

' 返回第一个工作表
ThisWorkbook.Worksheets(1).Activate

End Sub

关键修改说明 #

1. 循环结束后添加ThisWorkbook.Worksheets(1).Activate，直接激活工作簿的第一个工作表，实现遍历完成后的返回。
2. 修正xlContinous拼写错误为xlContinuous，并将重复设置的.Borders.LineStyle = xlThick改为.Borders.Weight = xlThick，避免覆盖连续边框样式。
3. 可选调整：将输入框提示和单元格内容改为中文，适配中文使用场景。

内容的提问来源于stack exchange，提问作者Ven