Question

真的需要帮助来重写我必须包含if语句的现有代码。 VBA代码根据工作表“粘贴L3此处”中A列中的数据创建和重命名我的选项卡。 enter image description here 我需要代码忽略＆amp;如果同一行的C列中的单元格=“Reversed”（可能是大写字母或小写字母），则转到下一行。

提前感谢您提供的任何帮助。

Option Explicit

Sub SheetsFromTemplate()
Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean
Dim shNAMES As Range, Nm As Range
With ThisWorkbook                                               'keep focus in this workbook
    Set wsTEMP = .Sheets("Template")                            'sheet to be copied
    wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)              'check if it's hidden or not
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible      'make it visible

    Set wsMASTER = .Sheets("Paste L3 here")                            'sheet with names
                                                                'range to find names to be checked
    Set shNAMES = wsMASTER.Range("A4:A" & Rows.Count).SpecialCells(xlConstants)     'or xlFormulas

    Application.ScreenUpdating = False                              'speed up macro
    For Each Nm In shNAMES                                      'check one name at a time
    If Not Evaluate("ISREF('" & CStr(Nm.Text) & "'!A1)") Then  'if sheet does not exist...
        If UCase$(Nm.Offset(0, 2).Value) <> "REVERSED" Then   '... Check if "Reversed" is present 2 columns to the right (C in this case)
            wsTEMP.Copy After:=.Sheets(.Sheets.Count)     '...create it from template
            ActiveSheet.Name = CStr(Nm.Text)              '...rename it
        End If
    End If
Next Nm

    wsMASTER.Activate                                           'return to the master sheet
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden       'hide the template if necessary
    Application.ScreenUpdating = True                           'update screen one time at the end
End With

MsgBox "All sheets created"
End Sub

Answer 1

我不会重写所有这些，但我相信您只需要扩展现有的if语句，或者使用OR条件，或者只是嵌套另一个if：

For Each Nm In shNAMES                         'check one name at a time
    If Not Evaluate("ISREF('" & CStr(Nm.Text) & "'!A1)") Then  'if sheet does not exist...
        if ucase$(nm.offset(0, 2).value) <> "RESERVED" then   '... Check if "Reserved" is present 2 columns to the right (C in this case)
            wsTEMP.Copy After:=.Sheets(.Sheets.Count)     '...create it from template
            ActiveSheet.Name = CStr(Nm.Text)              '...rename it
        end if
    End If
Next Nm

如果它没有按预期工作，它应该至少在正确的方向上找到你。

更新：

Option Explicit
Sub SheetsFromTemplate()

    Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean
    Dim shNAMES As Range, Nm As Range

    With ThisWorkbook
    'keep focus in this workbook
        Set wsTEMP = .Sheets("Template")         'sheet to be copied
        wasVISIBLE = (wsTEMP.Visible = xlSheetVisible) 'check if it's hidden or not

        If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible 'make it visible

        Set wsMASTER = .Sheets("Paste L3 here")  'sheet with names'range to find names to be checked
        Set shNAMES = wsMASTER.Range("A4:A" & Rows.Count).SpecialCells(xlConstants) 'or xlFormulas

        Application.ScreenUpdating = False       'speed up macro

        For Each Nm In shNAMES                         'check one name at a time

            If Not Evaluate("ISREF('" & CStr(Nm.Text) & "'!A1)") Then  'if sheet does not exist...

                If UCase$(nm.offset(0, 2).Value) <> "RESERVED" Then   '... Check if "Reserved" is present 2 columns to the right (C in this case)

                    wsTEMP.Copy After:=.Sheets(.Sheets.Count)     '...create it from template
                    ActiveSheet.Name = CStr(Nm.Text)              '...rename it

                End If

            End If

        Next Nm

        wsMASTER.Activate
        'return to the master sheet
        If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden 'hide the template if necessary

    Application.ScreenUpdating = True        'update screen one time at the end

    End With

    MsgBox "All sheets created"
End Sub

VBA有助于在我当前的VBA代码中包含if语句然后忽略

1 个答案: