Question

我正在尝试修改我放在一起的一些代码并且转换它有点困难。我之前的代码查看了文件夹中的文件，从文件中提取了名称，并使用它来确定它是否是正确的文件。我现在正在尝试运行主列表（一个文件），其中名称在单元格而不是文件名。

第一个用户形式要求提供first和last名称并显示一个按钮search。

Private Sub search_Click() ' In userform1

' Declare and set variables
Dim fname As String, lname As String
Dim Path As String, fCell As Range, fAdd As String
Path = "C:\Master List.xlsx"
fname = userform1.firstname_Search.Text
lname = userform1.lastname_Search.Text
' Store the name searched for
With Worksheets("Sheet1")
    .Range("A1") = fname
    .Range("A2") = lname
End With

Workbooks.Open (Path)

' Ensure the name searched for exists in the master list
With Workbooks("Master List").Worksheets("Master List").Range("A:A")
    Set fCell = .Find(fname)
    If Not fCell Is Nothing And fCell = fname Then
        ' Column A is first name, B is middle initial, C is last name, D is suffix, F is date of birth
        If fCell.Offset(0, 2) = lname Then
            userform2.firstname_Text.Text = fCell
            userform2.middlename_Text.Text = fCell.Offset(0, 1)
            userform2.lastname_Text.Text = Trim(fCell.Offset(0, 2) & " " & fCell.Offset(0, 3))
            userform2.dob_Text.Text = fCell.Offset(0, 5)
            Unload Me
            userform2.Show vbModeless
            userform3.Label1.Caption = "Now that we have the information from " & fCell & "'s file, what would you like to do?"
        Else
            MsgBox ("I could not find a client by that name.")
            Workbooks("Master List").Close False
        End If
    Else
        MsgBox ("I could not find a client by that name.")
        Workbooks("Master List").Close False
    End If
End With

End Sub

此部分似乎运行正常，将提取与输入的名字和姓氏相匹配的第一个条目。当第二个用户表单userform2被拉起时，问题就出现了，因为它会显示相关信息以确定是否已经提升了合适的人员。它会显示first，middle，last个名称和date of birth以及Yes和No按钮。点击Yes会提取相关信息（我尚未撰写），而点击No则会循环显示剩余的匹配项（例如，如果列出了3个William Jackson，请点击No应该循环到第二个;第二个No应该循环到第三个;它应该呈现MsgBox，因为该名称不存在其他条目。）

问题是我找不到绕过第一个No的方法;如果第二次点击No，则不会超过找到的第二个条目。我知道这是因为开始时有Set fCell = .Find(fname)和Set fCell = .FindNext(fCell)，但没有将一个单元格专用于No被点击的次数，有更好的方法吗？

Private Sub no_Click() ' In userform2

' Declare and set variables
Dim fname As String, lname As String
Dim Path As String, fCell As Range, fAdd As String
Path = "C:\Master List.xlsx"
With Workbooks("FirstWorkbook").Worksheets("Sheet1")
    fname = .Range("A1")
    lname = .Range("A2")
End With

' Ensure a client exists
With Workbooks("Master List").Worksheets("Master List").Range("A:A")
    Set fCell = .Find(fname)
    Set fCell = .FindNext(fCell)
    If Not fCell Is Nothing And fCell = fname Then
        If fCell.Offset(0, 2) = lname Then
            firstname_Text.Text = fCell
            middlename_Text.Text = fCell.Offset(0, 1)
            lastname_Text.Text = Trim(fCell.Offset(0, 2) & " " & fCell.Offset(0, 3))
            dob_Text.Text = fCell.Offset(0, 5)
            userform3.Label1.Caption = "Now that we have the information from " & fCell & "'s file, what would you like to do?"
            With Workbooks("FirstWorkbook").Worksheets("Sheet1")
                .Range("A1") = fCell
                .Range("A2") = fCell.Offset(0, 2)
            End With
        Else
            MsgBox ("I could not find a client by that name.")
            Workbooks("Master List").Close False
        End If
    Else
        MsgBox ("I could not find a client by that name.")
        Workbooks("Master List").Close False
    End If
End With

End Sub

也许有更好的方法来使用一个用户表单，或者更好的方式来搜索主列表;要么是一个有助于解决这个问题的解决方案，要么是朝着正确方向发展的一个方向，这样我可以通过不同的方式来做到这一点对我有很大帮助。

Answer 1

我建议将Find分解为独立函数，并让它返回搜索值的所有匹配项（在下面的示例中，它返回一个集合对象）。然后，您将该返回值存储在表单的全局字段中。

循环使用此类函数的返回值要比每次使用点击次数时重新运行搜索（从其他位置开始）要容易得多。

Public Function FindAll(rng As Range, val As String) As Collection
    Dim rv As New Collection, f As Range
    Dim addr As String

    Set f = rng.Find(what:=val, after:=rng.Cells(rng.Cells.Count), _
        LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False)

    If Not f Is Nothing Then addr = f.Address()

    Do Until f Is Nothing
        rv.Add f
        Set f = rng.FindNext(after:=f)
        If f.Address() = addr Then Exit Do
    Loop

    Set FindAll = rv
End Function

Answer 2

我认为您要列出所有文件夹和所有子文件夹中的所有文件。看看这个链接。

http://www.learnexcelmacro.com/wp/2011/11/how-to-get-list-of-all-files-in-a-folder-and-sub-folders/

下载文件;这是要走的路。在Excel工作表中列出所有路径和所有文件名后，您可以进行各种比较，操作等。

    Sub GetFilesInFolder(SourceFolderName As String)  

    '--- For Example:Folder Name= "D:\Folder Name\"  

    Dim FSO As Scripting.FileSystemObject  
    Dim SourceFolder As Scripting.folder, SubFolder As Scripting.folder  
    Dim FileItem As Scripting.File  

        Set FSO = New Scripting.FileSystemObject  
        Set SourceFolder = FSO.GetFolder(SourceFolderName)  

        '--- This is for displaying, whereever you want can be configured  

        r = 14  
        For Each FileItem In SourceFolder.Files  
            Cells(r, 2).Formula = r - 13  
            Cells(r, 3).Formula = FileItem.Name  
            Cells(r, 4).Formula = FileItem.Path  
            Cells(r, 5).Formula = FileItem.Size  
            Cells(r, 6).Formula = FileItem.Type  
            Cells(r, 7).Formula = FileItem.DateLastModified  
            Cells(r, 8).Formula = "=HYPERLINK(""" & FileItem.Path & """,""" & "Click Here to Open" & """)"  

            r = r + 1   ' next row number  
        Next FileItem  

        Set FileItem = Nothing  
        Set SourceFolder = Nothing  
        Set FSO = Nothing  
    End Sub  


Sub GetFilesInFolder(SourceFolderName As String, Subfolders As Boolean)  

'--- For Example:Folder Name= "D:\Folder Name\" and Flag as Yes or No  

Dim FSO As Scripting.FileSystemObject  
Dim SourceFolder As Scripting.folder, SubFolder As Scripting.folder  
Dim FileItem As Scripting.File  
'Dim r As Long  
    Set FSO = New Scripting.FileSystemObject  
    Set SourceFolder = FSO.GetFolder(SourceFolderName)  

    '--- This is for displaying, whereever you want can be configured  

    r = 14  
    For Each FileItem In SourceFolder.Files  
        Cells(r, 2).Formula = r - 13  
        Cells(r, 3).Formula = FileItem.Name  
        Cells(r, 4).Formula = FileItem.Path  
        Cells(r, 5).Formula = FileItem.Size  
        Cells(r, 6).Formula = FileItem.Type  
        Cells(r, 7).Formula = FileItem.DateLastModified  
        Cells(r, 8).Formula = "=HYPERLINK(""" & FileItem.Path & """,""" & "Click Here to Open" & """)"  

        r = r + 1   ' next row number  
    Next FileItem  

    '--- This is the Function to go each and Every Folder and get the Files. This is a Nested-Function Calling.  

    If Subfolders = True Then  
        For Each SubFolder In SourceFolder.Subfolders  
            ListFilesInFolder SubFolder.Path, True  
        Next SubFolder  
    End If  

    Set FileItem = Nothing  
    Set SourceFolder = Nothing  
    Set FSO = Nothing  
End Sub

搜索匹配的主列表

2 个答案: