正在搜索匹配的主列表

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