search和更新用户表单

我有这个代码，我在网上find一个VBAsearch用户表单。

我想做一些修改，所以显示的结果包括来自find的单元格行的其他列的数据，而不是只给出地址。

我最终希望能够从用户窗体中更改这些单元格中的值。 所以我可以search一个特定的行并更新表。

代码如下：

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