Question

我有这个代码，我在网上找到了VBA搜索用户表单。

我想做一些修改，所以显示的结果包括来自找到的细胞系的其他列的数据，而不是仅给出地址。

我最终希望能够从userform本身更改这些单元格中的值。所以我可以搜索特定的行并更新表格。

以下是代码：

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

搜索并更新用户表单

1 个答案: