[已解决]如何判断另一文件中是否存在指定工作表

向前650809

各位网友好
现同一文件夹中有两文件AB，在B中写代码，
代码判断文件A中是否存在工作表C ,代码如何编写，如果把A改为变化的（是一个变量，即文件名称是变化的，但工作表C不变）
请指导，谢谢

最佳答案

月排行榜 / 总排行榜

望帝春心

2017-2-28 20:45

1. Sub test()
   
2.     Application.ScreenUpdating = False
   
3.     Dim sht As String, file As String, path As String, wb As Workbook
   
4.     sht = "判断结果"
   
5.     On Error Resume Next
   
6.     Set wsht = ThisWorkbook.Sheets(sht)
   
7.     If Err.Number <> 0 Then
   
8.         ThisWorkbook.Sheets.Add.Name = sht
   
9.     Else
   
10.         ThisWorkbook.Sheets(sht).Cells.ClearContents
    
11.         Err.Clear
    
12.     End If
    
13.     path = ThisWorkbook.path
    
14.     file = Dir(path & "\*.xls*")
    
15.     Do While file <> ""
    
16.         i = i + 1
    
17.         If file <> ThisWorkbook.Name Then
    
18.             Workbooks.Open path & "" & file
    
19.             Set wb = ActiveWorkbook
    
20.             On Error Resume Next
    
21.             Set jude = wb.Sheets("测试")
    
22.             If Err <> 0 Then
    
23.                 ThisWorkbook.Sheets(sht).Cells(i, 1) = file & "工作薄不存在指定工作表！"
    
24.             Else
    
25.                 ThisWorkbook.Sheets(sht).Cells(i, 1) = file & "工作薄存在指定工作表！"
    
26.             End If
    
27.             Err.Clear
    
28.             wb.Close
    
29.         Else: ThisWorkbook.Sheets(sht).Cells(1, 1) = "判断结果"
    
30.         End If
    
31.         file = Dir
    
32.     Loop
    
33.     Application.ScreenUpdating = True
    
34. End Sub

复制代码

跳转到最佳答案楼层

ilovelittle

判断.rar (13.82 KB, 下载次数: 1)

2017-2-28 11:58 上传

点击文件名下载附件

向前650809

要判断文件A中是否存在工作表C

望帝春心

1. Sub test()
   
2.     Application.ScreenUpdating = False
   
3.     Dim sht As String, file As String, path As String, wb As Workbook
   
4.     sht = "判断结果"
   
5.     On Error Resume Next
   
6.     Set wsht = ThisWorkbook.Sheets(sht)
   
7.     If Err.Number <> 0 Then
   
8.         ThisWorkbook.Sheets.Add.Name = sht
   
9.     Else
   
10.         ThisWorkbook.Sheets(sht).Cells.ClearContents
    
11.         Err.Clear
    
12.     End If
    
13.     path = ThisWorkbook.path
    
14.     file = Dir(path & "\*.xls*")
    
15.     Do While file <> ""
    
16.         i = i + 1
    
17.         If file <> ThisWorkbook.Name Then
    
18.             Workbooks.Open path & "" & file
    
19.             Set wb = ActiveWorkbook
    
20.             On Error Resume Next
    
21.             Set jude = wb.Sheets("测试")
    
22.             If Err <> 0 Then
    
23.                 ThisWorkbook.Sheets(sht).Cells(i, 1) = file & "工作薄不存在指定工作表！"
    
24.             Else
    
25.                 ThisWorkbook.Sheets(sht).Cells(i, 1) = file & "工作薄存在指定工作表！"
    
26.             End If
    
27.             Err.Clear
    
28.             wb.Close
    
29.         Else: ThisWorkbook.Sheets(sht).Cells(1, 1) = "判断结果"
    
30.         End If
    
31.         file = Dir
    
32.     Loop
    
33.     Application.ScreenUpdating = True
    
34. End Sub

复制代码

望帝春心

代码中的测试改成你要判断的是否存在的工作表名