搜索并更新用户表单

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 
    '....