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检查文件夹中的文件名，然后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

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

2 个答案: