创建新工作表

Question

我有一个工作簿，其中包含工作表，工作表名称中包含“benefits”文本。例如;医疗福利或牙科福利。总会有至少一个，但也可能有几个。

我正在尝试编写一个宏，该宏将在工作表名称中找到带有文本“benefits”的工作表，并且在第 40 行中至少有一个单词 TRUE 的实例。

当满足这两个条件时，我需要使用相同的工作表名称创建一个新工作表，但将文本“Benefits”替换为文本“Final”，换句话说；如果工作表 MEDICALBenefits 在第 40 行的一个或多个单元格中为 TRUE，则将创建一个名为 MEDICALFinal 的新工作表。

同样，如果工作表 DENTALBenefits 在第 40 行的一个或多个单元格中为 TRUE，则将创建一个名为 DENTALFinal 的新工作表。

然后我需要它遍历所有工作表，在名称中查找“Benefits”并在第 40 行查找 TRUE，然后创建一个新工作表。

这是我目前拥有的代码，但需要帮助命名新工作表。

约旦

 'Look for worksheet names *benefits* with checkbox(s) = true
Sub CreateFinalWorksheet()
    Dim sh As Worksheet
    Dim iVal As Integer
    Application.ScreenUpdating = False
    For Each sh In ActiveWorkbook.Sheets
        iVal = Application.WorksheetFunction.CountIf(Range("40:40"), "TRUE")
        If (LCase$(sh.Name) Like "*benefits*") And (iVal > 0) Then Call AddWorksheet
    Next sh
    Application.ScreenUpdating = True
End Sub


'Called from CreateFinalWorksheet.
'Add worksheet with same sheet name replacing *benefits* with *final*
Sub AddWorksheet()
    Dim sh As Worksheet
    With ThisWorkbook
        Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        ws.Name = "MedicalFinal"
    End With
End Sub

Answer 1

编辑在 OP 澄清后，他想找到所有“*好处”表

在

iVal = Application.WorksheetFunction.CountIf(Range("40:40"), "TRUE")

您缺少当前的sh 工作表参考，因此您希望编写如下：

iVal = Application.WorksheetFunction.CountIf(sh.Range("40:40"), "TRUE")

对于上述内容和您的主要问题，我会如下：

Sub CreateFinalWorksheet()
    Dim sh As Worksheet

    Application.ScreenUpdating = False
    For Each sh In ActiveWorkbook.Sheets
        If (LCase$(sh.Name) Like "*benefits") Then
            If WorksheetFunction.CountIf(sh.Rows(40), "TRUE") = 0 Then AddWorksheet sh.Name
        End If
    Next sh
    Application.ScreenUpdating = True
End Sub

Sub AddWorksheet(shtName As String)
    Dim sh As Worksheet
    With ThisWorkbook
        .Sheets.Add(After:=.Sheets(.Sheets.count)).Name = Replace(LCase$(shtName), "benefits", "Final")
    End With
End Sub

Answer 2

在您的AddWorksheet 例程中添加一个参数，让它成为“好处”工作表

If (LCase$(sh.Name) Like "*benefits*") And (iVal > 0) Then AddWorksheet sh

Sub AddWorksheet(benef as worksheet)
    ....
    ws.name = Replace(benef.name, "benefits", "Final", , vbTextCompare)

最后，你还可以在这个sub里面做其他事情，比如从参数工作表benef复制一些数据。