想检查是否有与文件同名的工作表

Question

要检查是否有与文件同名的工作表。

目前我让 filnam 将文件作为数组打开，但希望它循环浏览代码并查看是否有同名的工作表。

我已使用拆分来删除路径名和扩展名，但无法对其进行检查。

对于代码的混乱，我深表歉意。一直在努力整理，然后我会整理一下。还有更多代码，但这不是必需的，因为如果没有匹配项，我希望它运行该代码。

你能帮忙吗？

Sub sort_it_out()

 Dim wb1 As Workbook
 Dim wb2 As Workbook
 Dim Sheet As Worksheet
 Dim filnam As Variant
 On Error GoTo errorhandler

 Set wb1 = ActiveWorkbook

 ChDir Application.ActiveWorkbook.path

    'get files
    filnam = Application.GetOpenFilename(FileFilter:="2D Table Formats (*.htm;*.xlsm;*.html),*.htm;*.xlsm;*.html", Title:="Select 2D Table", MultiSelect:=True)

    'set the array
    If IsArray(filnam) Then 'if at least one file is selected, this will be an Array

    'define j as the array
    For j = LBound(filnam) To UBound(filnam)

    'remove path and extension
    Dim s As String, a() As String, p As String
    s = filnam(j)
    a() = Split(s, "\")
    p = Split(a(UBound(a)), ".")(0)

    MsgBox "p " & p

    'check if worksheet exists
    For Each ws_check In ThisWorkbook.Worksheets()

        If ws_check.Name = p Then
            MsgBox "Its there"
            Exit Sub
            Else
        End If
   Next ws_check

   'continue code from here

然后运行代码......但由于某种原因它没有循环数组。一次只有一个文件。你能帮忙吗？

Answer 1

遵循您的代码有点困难，但这是否符合您的要求？

我认为您将文件名存储在 p 变量中，因此我下面的代码将检查工作簿中的每个工作表，以查看它们是否与 p 变量具有相同的名称。

Public Sub CompareWorksheetNamesToFiles()

    Dim file_name As String
    file_name = ActiveWorkbook.Name

    Dim ws_check As Worksheet
    For Each ws_check In ThisWorkbook.Worksheets()

        If ws_check.Name = p Then
            Debug.Print ("Do Something")
        End If

    Next ws_check

End Sub

Answer 2

我现在已经解决了所有问题。

现在这将打开文件位置，将它们的路径缩短为仅文件名减去扩展名，然后 ws check 根据文件名检查工作表，然后 looper 跳转到下一个。

感谢 alwaysdata 帮助我。

Sub sort_it_out()

 Dim filnam As Variant

 'open file locations
 filnam = Application.GetOpenFilename(FileFilter:="2D Table Formats (*.htm;*.xlsm;*.html),*.htm;*.xlsm;*.html", Title:="Select 2D Table", MultiSelect:=True)

 'if at least one file is selected, this will be an Array 
    If IsArray(filnam) Then 

    For j = LBound(filnam) To UBound(filnam)

 'remove pathway and extension from entire filename and path. ie C:\open.txt becomes open.

    Dim s As String, a() As String, p As String
    s = filnam(j)
    a() = Split(s, "\")
    p = Split(a(UBound(a)), ".")(0)


 'check if worksheet exists against p ... ie if theres a worksheet called open it will goto the next option if not it will continue through code
    For Each ws_check In ThisWorkbook.Worksheets()

        If ws_check.Name = p Then
            MsgBox p & " has already been transfered across. ", vbExclamation 'lets the user know this is already there.

            GoTo looper
            Else
        End If
   Next ws_check

 'do something here with the code if not found. IE MSGBOX " NOT FOUND "

 'jump to this point if there is a match. 
looper:
Next
    Else
    Exit Sub

End If

End Sub