Question

我想通过宏添加额外的一周。我的工作手册包含了我的同事们从星期一到星期日的几个项目的所有工作时间以及该周的摘要。我想添加一个额外的一周与该摘要相同的引用。所以我设置了一个数组。

每次我想运行这个宏我想将数组复制到后面并为新周添加一个额外的数字（重新编号/重命名工作表），所以我得到第1周，第2周，第3周正确的日子（星期一（星期）1，星期一（星期）2，星期一（星期）3等）。

这已经是我得到的了：

Sub Macro1()

With Sheets(Array("Week 1", "Monday 1", "Tuesday 1", "Wednesday 1", "Thursday 1", _
    "Friday 1", "Saturday 1", "Sunday 1"))

Sheets(Array(""Week 1", "Monday 1", "Tuesday 1", "Wednesday 1", "Thursday 1", _
    "Friday 1", "Saturday 1", "Sunday 1")).Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)

End With

当我运行这个宏时，我得到了这个：

macro1()

的图片

我想要那张表＆＃34;星期一1（2）＆＃34;自动重新编号为：＆＃34;星期一2＆＃34;等等整整一周。

当我再添加一周时，它会添加工作表：第3周，周一3 ...周日3

Answer 1

这没有任何真正的错误处理。我在循环中使用currWeek进行演示。您可以将其值设置在循环之外，并将其设置为最近一周。您还可以提示用户通过inputbox输入此值。 Sub remove()只是为了在测试期间摆脱添加的工作表。这为您提供了一般结构。

如果您有一个名为"Main"的工作表，并且在单元格B2中输入了您想要添加的周数，则以下代码会检查当前最长工作周数（基于上一个当前工作表）名称），然后从这个添加周开始循环。

Sub AddWeeks2()

Dim startWksheetCount As Long
Dim wb As Workbook

Set wb = ThisWorkbook

Dim currWeek As Long

Dim startWeek As Long
Dim endWeek As Long

Dim tempStr As String
tempStr = wb.Sheets(wb.Sheets.Count).Name

startWeek = CInt(Right$(tempStr, Len(tempStr) - InStr(1, tempStr, " ")))
endWeek = startWeek + wb.Sheets("Main").Range("B2") - 1

If Not IsNumeric(startWeek) Or Not IsNumeric(endWeek) Then

    MsgBox "Please ensure start week and end week are numbers"
    Exit Sub

Else

    For currWeek = startWeek To endWeek

        startWksheetCount = wb.Sheets.Count

        wb.Sheets(Array("Week " & currWeek, "Monday " & currWeek, "Tuesday " & currWeek, "Wednesday " & currWeek, "Thursday " & currWeek, _
            "Friday " & currWeek, "Saturday " & currWeek, "Sunday " & currWeek)).Copy After:=wb.Sheets(wb.Sheets.Count)

        Dim currSheet As Long
        Dim sheetName As String
        Dim cutOff As Long

        For currSheet = startWksheetCount + 1 To wb.Sheets.Count

            sheetName = wb.Sheets(currSheet).Name

            If Not Left(sheetName, 4) = "Week" Then

                cutOff = InStr(1, sheetName, "y")
                wb.Sheets(currSheet).Name = Left$(sheetName, cutOff) & " " & CStr(currWeek + 1)

            Else

                wb.Sheets(currSheet).Name = "Week " & CStr(currWeek + 1)

            End If

        Next currSheet

    Next currWeek

End If

End Sub






Private Sub remove()

Dim ws As Worksheet
Dim wsName As String

Application.DisplayAlerts = False

For Each ws In ThisWorkbook.Worksheets

    wsName = ws.Name

    If Not wsName = "Main" Then

        If Right$(wsName, 1) <> CStr(1) Or _
           Len(Right$(wsName, Len(wsName) - InStr(1, wsName, " "))) > 1 Then

           ws.Delete

        End If

    End If


Next ws

Application.DisplayAlerts = True

End Sub

复制工作表数组并重新编号

1 个答案: