搜索並更新用戶表單

Question

我有我在網上找到的VBA搜索用戶表單的代碼。

我想進行一些修改，以便顯示的結果包括來自找到的單元格行的其他列的數據，而不是隻給出地址。

我最終希望能夠從用戶窗體中更改這些單元格中的值。所以我可以搜索特定的行並更新表格。

下面的代碼：

Private Sub TextBox_Find_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 
'Calls the FindAllMatches routine as user types text in the textbox 

    Call FindAllMatches 

End Sub 

Private Sub Label_ClearFind_Click() 
'Clears the find text box and sets focus 

    Me.TextBox_Find.Text = "" 
    Me.TextBox_Find.SetFocus 

End Sub 

Sub FindAllMatches() 
'Find all matches on activesheet 
'Called by: TextBox_Find_KeyUp event 

Dim SearchRange As Range 
Dim FindWhat As Variant 
Dim FoundCells As Range 
Dim FoundCell As Range 
Dim arrResults() As Variant 
Dim lFound As Long 
Dim lSearchCol As Long 
Dim lLastRow As Long 

    If Len(f_FindAll.TextBox_Find.Value) > 1 Then 'Do search if text in find box is longer than 1 character. 

     Set SearchRange = ActiveSheet.UsedRange.Cells 

     FindWhat = f_FindAll.TextBox_Find.Value 
     'Calls the FindAll function 
     Set FoundCells = FindAll(SearchRange:=SearchRange, _ 
           FindWhat:=FindWhat, _ 
           LookIn:=xlValues, _ 
           LookAt:=xlPart, _ 
           SearchOrder:=xlByColumns, _ 
           MatchCase:=False, _ 
           BeginsWith:=vbNullString, _ 
           EndsWith:=vbNullString, _ 
           BeginEndCompare:=vbTextCompare) 
     If FoundCells Is Nothing Then 
      ReDim arrResults(1 To 1, 1 To 2) 
      arrResults(1, 1) = "No Results" 
     Else 
      'Add results of FindAll to an array 
      ReDim arrResults(1 To FoundCells.Count, 1 To 2) 
      lFound = 1 
      For Each FoundCell In FoundCells 
       arrResults(lFound, 1) = FoundCell.Value 
       arrResults(lFound, 2) = FoundCell.Address 
       lFound = lFound + 1 
      Next FoundCell 
     End If 

     'Populate the listbox with the array 
     Me.ListBox_Results.List = arrResults 

    Else 
     Me.ListBox_Results.Clear 
    End If 

End Sub 

Private Sub ListBox_Results_Click() 
'Go to selection on sheet when result is clicked 

Dim strAddress As String 
Dim l As Long 

    For l = 0 To ListBox_Results.ListCount 
     If ListBox_Results.Selected(l) = True Then 
      strAddress = ListBox_Results.List(l, 1) 
      ActiveSheet.Range(strAddress).Select 
      GoTo EndLoop 
     End If 
    Next l 

EndLoop: 

End Sub 

Private Sub CommandButton_Close_Click() 
'Close the userform 

    Unload Me 

End Sub 

Answer 1

例如，對於四個數據的列，編輯您的窗體的列表框中設置ColumnCount 4和下面編輯代碼：

'.... 
    If FoundCells Is Nothing Then 
     ReDim arrResults(1 To 1, 1 To 4) '<<<edit 
     arrResults(1, 1) = "No Results" 
    Else 
     'Add results of FindAll to an array 
     ReDim arrResults(1 To FoundCells.Count, 1 To 4) '<<<edit 
     lFound = 1 
     For Each FoundCell In FoundCells 
      arrResults(lFound, 1) = FoundCell.Value 
      arrResults(lFound, 2) = FoundCell.Address 
      'EDIT: adding two new columns 
      arrResults(lFound, 3) = FoundCell.EntireRow.Cells(4).Value 
      arrResults(lFound, 4) = FoundCell.EntireRow.Cells(5).Value 

      lFound = lFound + 1 
     Next FoundCell 
    End If 

    'Populate the listbox with the array 
    Me.ListBox_Results.List = arrResults 
    '....