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

时间:2018-05-21 08:03:58

标签: excel vba excel-vba

真的需要帮助来重写我必须包含if语句的现有代码。 VBA代码根据工作表“粘贴L3此处”中A列中的数据创建和重命名我的选项卡。 enter image description here 我需要代码忽略&如果同一行的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

1 个答案:

答案 0 :(得分:0)

我不会重写所有这些,但我相信您只需要扩展现有的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