如何判断多工作簿是否存在指定工作表，返回判断结果

xyd617

lsc900707 发表于 2018-7-31 12:02
上一帖大神有回复你的文件夹有隐藏的文件，看看是不是这个原因。
附件测试代码是没有问题的。

我上传了 我出错的附件， 麻烦有时间时看下，非常感谢！

xiangbaoan

改成这样再试     
If Left(f.Name, 2) <> "~$" And f.Name <> ThisWorkbook.Name And InStr(f.Name, ".xls") Then
当你打开某工作簿时，就在当前路径下生成一个以 ~$开头的后面相同的隐藏文件，如：
~$TT核对系统.xlsm
所以要作一个判断，The end.

此为编辑补充：
fso获取的文件是路径下所有的文件，包含各种后缀名，各种属性的文件，就此为止。

lsc900707

xyd617 发表于 2018-7-31 14:53
我上传了 我出错的附件， 麻烦有时间时看下，非常感谢！

Sub test()
    Dim arr(1 To 1000, 1 To 2)
    Application.ScreenUpdating = False
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xls")
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Set wb = GetObject(p & f)
            m = m + 1
            arr(m, 1) = Split(f, ".")(0)
            For Each sht In wb.Sheets
                If InStr(sht.Name, "data") Then
                    arr(m, 2) = "存在"
                Else
                    arr(m, 2) = "不存在"
                End If
            Next
            Workbooks(f).Close False
        End If
        f = Dir
    Loop
    [a2].CurrentRegion.Offset(1).ClearContents
    [a3].Resize(m, 2) = arr
    Application.ScreenUpdating = True
End Sub

xyd617

lsc900707 发表于 2018-7-31 15:36
Sub test()
    Dim arr(1 To 1000, 1 To 2)
    Application.ScreenUpdating = False

为什么 返回结果有误。TT-CC那张工作表 没有data 这个指定工作表，仅有data1这个工作表，结果显示存在，结果有误，不知哪里出了问题

lsc900707

xyd617 发表于 2018-7-31 16:22
为什么 返回结果有误。TT-CC那张工作表 没有data 这个指定工作表，仅有data1这个工作表，结果有误，不知 ...

你有相近的工作表名就不能模糊查找，要用精确查找了：
Sub test4()
    Dim arr(1 To 1000, 1 To 2)
    Application.ScreenUpdating = False
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xls*")
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Set wb = GetObject(p & f)
            m = m + 1
            arr(m, 1) = Split(f, ".")(0)
            For Each sht In wb.Sheets
                If sht.Name = "data" Then
                    arr(m, 2) = "存在"
                Else
                    arr(m, 2) = "不存在"
                End If
            Next
            Workbooks(f).Close False
        End If
        f = Dir
    Loop
    [a2].CurrentRegion.Offset(1).ClearContents
    [a3].Resize(m, 2) = arr
    Application.ScreenUpdating = True
End Sub

xyd617

lsc900707 发表于 2018-7-31 16:30
你有相近的工作表名就不能模糊查找，要用精确查找了：
Sub test4()
    Dim arr(1 To 1000, 1 To 2)

我工作表名称换成指定的TT.TT006,判断结果会出现错误，是否和指定工作表位置有关？

lsc900707

xyd617 发表于 2018-7-31 17:00
我工作表名称换成指定的TT.TT006,判断结果会出现错误，是否和指定工作表位置有关？

你的工作表名改来改去的，免得改代码，你在d1单元格输入要查询的工作表名，再运行代码：
Sub test4()
    Dim arr(1 To 1000, 1 To 2)
    Application.ScreenUpdating = False
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xls*")
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Set wb = GetObject(p & f)
            m = m + 1
            arr(m, 1) = Split(f, ".")(0)
            For Each sht In wb.Sheets
                If InStr(sht.Name, [d1]) Then n = n + 1
                If n > 0 Then
                    arr(m, 2) = "存在"
                Else
                    arr(m, 2) = "不存在"
                End If
            Next
            Workbooks(f).Close False
        End If
        f = Dir
    Loop
    [a2].CurrentRegion.Offset(1).ClearContents
    [a3].Resize(m, 2) = arr
    Application.ScreenUpdating = True
End Sub

lsc900707

xyd617 发表于 2018-7-31 17:00
我工作表名称换成指定的TT.TT006,判断结果会出现错误，是否和指定工作表位置有关？

参考附件：

xyd617

lsc900707 发表于 2018-7-31 21:22
参考附件：

看了你的附件，不知你是否注意到，F7777那张工作表实际含  指定工作表的，但是结果还是不存在。

lsc900707

xyd617 发表于 2018-7-31 21:43
看了你的附件，不知你是否注意到，F7777那张工作表实际含  指定工作表的，但是结果还是不存在。

附件结果明明是这样的耶，我i真的无语了。
                        TT.TT006
工作簿名称        是否存在               
TT-F7777        存在               
TT-F8888        存在               
TT-F9999        存在