Excel VBA-用于检查工作簿中是否存在特定工作表和命名单元格的函数

我有一个sub，它打开我创建的清单的旧版本，然后导入数据。用户选择文件后，我想检查该工作表上是否存在特定的工作表和命名单元格（为了验证，他们选择了正确的文件-工作表将始终为“主页”，单元格为“版本”）。如果其中一个不存在，则我需要一个消息框并退出sub。如果它们都存在，则继续导入其余部分

大多数情况下都是有效的，这只是对命名工作表/单元格的第一次检查。主要问题是子系统的这一部分：

If Not WorksheetExists("Main Page") Then
    MsgBox "The selected file does not appear to be an older version of the checklist." & vbNewLine & vbNewLine & "Please check that you have selected the correct file."
    wbCopyFrom.Close SaveChanges:=False
    Exit Sub
End If

以及被调用的函数：

Function WorksheetExists(sName As String) As Boolean

WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")

End Function

此函数目前检查工作表名称是否正确。但是我对如何检查单元格名称有点困惑——我需要另一个函数吗？或者我可以编辑上面的函数来同时检查这两个函数吗？我想我可以改变路线：

WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")

包含单元格名称而不是A1位

如果有帮助的话，整个子函数和其他函数的上下文如下所示

Sub ImportLists()

If MsgBox("The import process will take some time (approximately 10 minutes); please be patient while it is running. It is recommended you close any other memory-intensive programs before continuing. Click 'Cancel' to run at another time.", vbOKCancel) = vbCancel Then Exit Sub

Application.ScreenUpdating = False

Dim OldFile As Variant, wbCopyFrom As Workbook, wsCopyFrom As Worksheet, wbCopyTo As Workbook, wsCopyTo As Worksheet, OutRng As Range, c As Range, RangeName As Range

Set wbCopyTo = ActiveWorkbook
ChDir ThisWorkbook.Path
OldFile = Application.GetOpenFilename("All Excel Files (*.xls*)," & "*.xls*", 1, "Select a previous version of the checklist", "Import", False)

If TypeName(OldFile) = "Boolean" Then
    MsgBox "An error occured while importing the old version." & vbNewLine & vbNewLine & "Please check you have selected the correct checklist file and filetype (.xlsm)."
Exit Sub
End If

Set wbCopyFrom = Workbooks.Open(OldFile)

If Not WorksheetExists("Main Page") Then
    MsgBox "The selected file does not appear to be an older version of the checklist." & vbNewLine & vbNewLine & "Please check that you have selected the correct file."
    wbCopyFrom.Close SaveChanges:=False
    Exit Sub
End If

OldVersion = Right(wbCopyFrom.Sheets("Main Page").Range("Version").Value, Len(wbCopyFrom.Sheets("Main Page").Range("Version").Value) - 1)
NewVersion = Right(wbCopyTo.Sheets("Main Page").Range("Version").Value, Len(wbCopyTo.Sheets("Main Page").Range("Version").Value) - 1)

If NewVersion < OldVersion Then
    MsgBox "The selected older version of the checklist (v" & OldVersion & ") appears to be newer than the current version (v" & NewVersion & ")." & vbNewLine & vbNewLine & "Please check that you have selected the correct older version of the checklist or that the current checklist is not an older version."
    wbCopyFrom.Close SaveChanges:=False
    Exit Sub
End If

For Each wsCopyFrom In wbCopyFrom.Worksheets
    If wsCopyFrom.Name <> "Set List" And wsCopyFrom.Name <> "Rarity Type Species List" And wsCopyFrom.Name <> "Need List" And wsCopyFrom.Name <> "Swap List" And wsCopyFrom.Name <> "Reference List" Then
        Set wsCopyTo = wbCopyTo.Worksheets(wsCopyFrom.Name)
        Set OutRng = UsedRangeUnlocked(wsCopyFrom)
        If Not OutRng Is Nothing Then
            For Each c In OutRng
                If wsCopyTo.Range(c.Address).Locked = False Then
                    c.Copy wsCopyTo.Range(c.Address)
                End If
            Next c
        End If
    End If
Next wsCopyFrom

wbCopyFrom.Close SaveChanges:=False
Call CalcRefilter

Application.ScreenUpdating = True

MsgBox "The checklist was successfully imported from version " & OldVersion & " and updated to version " & NewVersion & "." & vbNewLine & vbNewLine & "Don't forget to save the new version."

End Sub

Function WorksheetExists(sName As String) As Boolean

WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")

End Function

Function UsedRangeUnlocked(ws As Worksheet) As Range

Dim RngUL As Range, c As Range

For Each c In ws.UsedRange.Cells
    If Not c.Locked Then
        If RngUL Is Nothing Then
            Set RngUL = c
        Else
            Set RngUL = Application.Union(RngUL, c)
        End If
    End If
Next c
Set UsedRangeUnlocked = RngUL

End Function

子导入列表（）
如果MsgBox（“导入过程需要一些时间（大约10分钟）；请耐心等待。建议您在继续之前关闭任何其他内存密集型程序。单击“取消”以在其他时间运行。”，vbOKCancel）=vbCancel，然后退出Sub
Application.ScreenUpdating=False
将旧文件作为变量、wbCopyFrom作为工作簿、wsCopyFrom作为工作表、wbCopyTo作为工作簿、wsCopyTo作为工作表、OutRng作为范围、c作为范围、RangeName作为范围
将wbCopyTo设置为=活动工作簿
ChDir ThisWorkbook.Path
OldFile=Application.GetOpenFilename（“所有Excel文件（*.xls*），”和“*.xls*”，1，“选择检查表的早期版本”，“导入”，False）
如果TypeName（OldFile）=“Boolean”，则
MsgBox“导入旧版本时出错。”&vbNewLine&vbNewLine&“请检查您是否选择了正确的检查表文件和文件类型（.xlsm）。”
出口接头
如果结束
设置wbCopyFrom=工作簿。打开（旧文件）
如果不是工作表列表（“主页”），则
MsgBox“所选文件似乎不是清单的旧版本。”&vbNewLine&vbNewLine&“请检查您是否选择了正确的文件。”
wbCopyFrom.Close SaveChanges:=False
出口接头
如果结束
OldVersion=右侧（wbCopyFrom.Sheets（“主页”）.Range（“版本”）.Value，Len（wbCopyFrom.Sheets（“主页”）.Range（“版本”）.Value）-1）
新版本=右（wbCopyTo.Sheets（“主页”）.范围（“版本”）.值，Len（wbCopyTo.Sheets（“主页”）.范围（“版本”）.值）-1）
如果新版本<旧版本，则
MsgBox“所选检查表的旧版本（v“&OldVersion&”）似乎比当前版本（v“&NewVersion&”）新。”&vbNewLine&vbNewLine&“请检查您是否选择了正确的旧版本检查表，或者当前检查表不是旧版本。”
wbCopyFrom.Close SaveChanges:=False
出口接头
如果结束
对于wbCopyFrom.worksheet中的每个wsCopyFrom
如果wsCopyFrom.Name“设置列表”和wsCopyFrom.Name“稀有类型物种列表”和wsCopyFrom.Name“需要列表”和wsCopyFrom.Name“交换列表”和wsCopyFrom.Name“参考列表”，则
设置wsCopyTo=wbCopyTo.Worksheets（wsCopyFrom.Name）
Set-OutRng=UsedRangeUnlocked（wsCopyFrom）
如果没有出局，那就什么都不是了
对于每个c输入输出
如果wsCopyTo.Range（c.Address）.Locked=False，则
c、 复制wsCopyTo.Range（c.Address）
如果结束
下一个c
如果结束
如果结束
下一个wsCopyFrom
wbCopyFrom.Close SaveChanges:=False
调用CalcRefilter
Application.ScreenUpdating=True
MsgBox“检查表已成功从版本“&OldVersion&”导入，并更新为版本“&NewVersion&”&vbNewLine&vbNewLine&“不要忘记保存新版本。”
端接头
函数工作表列表（sName为字符串）为布尔值
WorksheetExists=Evaluate（“ISREF（“&sName&”！A1）”）
端函数
函数UsedRangeUnlocked（ws-As工作表）作为范围
变暗RngUL作为范围，c作为范围
对于ws.UsedRange.Cells中的每个c
如果不是c，则锁定
如果RngUL什么都不是那么
设置RngUL=c
其他的
Set RngUL=Application.Union（RngUL，c）
如果结束
如果结束
下一个c
设置UsedRangeUnlocked=RngUL
端函数

您可以尝试访问该范围。如果抛出错误，则该错误不存在：

Function RangeExists(RangeName As String) As Boolean
    Dim rng As Range
    On Error Resume Next
    Set rng = Range(RangeName)
    On Error GoTo 0 'needed to clear the error. Alternative Err.Clear
    RangeExists = Not rng Is Nothing
End Function

或立即检查两者是否都存在（工作表和范围）：

如果要在特定工作簿中测试它，请执行以下操作：

Function SheetAndRangeExists(InWorkbook As Workbook, WorksheetName As String, RangeName As String) As Boolean
    Dim rng As Range
    On Error Resume Next
    Set rng = InWorkbook.Worksheets(WorksheetName).Range(RangeName)
    On Error GoTo 0
    SheetAndRangeExists = Not rng Is Nothing
End Function

---

并称之为“SheetAndRangeExists”（此工作簿“主页”、“版本”）

绝对精彩。我用了你三个答案中的最后一个，一次检查了所有答案。在许多不同的组合上对其进行了测试，并且仅当所选文件具有工作表“主页”和单元格“版本”时，子文件才会继续。此后，我添加了一个检查，以查看单元格是否以“v”开头，后面是数字，而不是空白。非常感谢。

Function SheetAndRangeExists(InWorkbook As Workbook, WorksheetName As String, RangeName As String) As Boolean
    Dim rng As Range
    On Error Resume Next
    Set rng = InWorkbook.Worksheets(WorksheetName).Range(RangeName)
    On Error GoTo 0
    SheetAndRangeExists = Not rng Is Nothing
End Function