Question

我有一个工作簿，其中包含工作表，工作表中的文字名称为“Benefits”。例如;医疗福利或DENTALBenefits。总会有至少一个，但可能有几个。

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

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

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

然后我需要它遍历所有表格，在名称中寻找“好处”，在第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

在<!DOCTYPE html> <html> <head> <script src="https://ajax.googleapis.com/ajax/libs/jquery/3.1.1/jquery.min.js"></script> <script> $.getJSON('http://website.com/php/script.php', function(data) { var items = []; $.each(data, function(key, val) { items.push('<li id="' + key + '">' + val + '</li>'); }); $('<ul/>', { 'class': 'my-new-list', html: items.join('') }).appendTo('body'); }); </script> </head> <body> <span id="output"></span> </body> </html>例程中添加一个参数，让它成为＆＃34;好处＆＃34;工作表

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)复制一些数据。

创建新工作表

2 个答案: