正在搜索匹配的主列表

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个威廉杰克逊列出，点击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

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

正是通过这样的函数的返回值周期更容易比重新运行搜索（开始在不同的位置）每次使用点击号

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