如何在VBA用户窗体中使用SPLIT函数实现多条目搜索？

Got it, let's tackle this multi-entry search feature for your VBA form. The core fix uses the Split function to break down semicolon-separated inputs into an array, then checks if the current row's value exists in that array. Here's the full modified code with explanations:

Dim opRow As Long
Dim varenNr5 As String
Dim varenNr5Arr As Variant
Dim j As Integer ' For trimming array elements

varenNr5 = Trim(Me.txtVaren5.Value)
batchNr5 = VBA.UCase(Me.txtBatch5.Value)
batchNr7 = Trim(Me.txtBatch7.Value)
fremS = Trim(Me.txtFrems.Value)
henS = Trim(Me.txtHens.Value)
antaL = Trim(Me.txtAntal.Value)
varenVan = Trim(Me.txtVarenavn.Value)
klinkVar = "" ' Initialize to avoid undefined value errors
If Me.Klinik_JA.Value Then klinkVar = "JA"
If Me.Klinik_NEJ.Value Then klinkVar = "NEJ"
If Me.Klinik_VEDIKKE.Value Then klinkVar = "VED IKKE"

If varenNr5 = "" And batchNr5 = "" And batchNr7 = "" And fremS = "" And henS = "" And antaL = "" And klinkVar = "" Then _
    MsgBox "Udfyld minimum ét felt": Exit Sub

' Process multi-entry input for varenNr5
If varenNr5 <> "" Then
    varenNr5Arr = Split(varenNr5, ";")
    ' Trim whitespace from each element to handle inputs like "entry12; entry13"
    For j = LBound(varenNr5Arr) To UBound(varenNr5Arr)
        varenNr5Arr(j) = Trim(varenNr5Arr(j))
    Next j
End If

Dim lRow As Long, i As Long
With Sheet2 'Raw Data
    lRow = .Range("A" & .Rows.Count).End(xlUp).Row
    Sheet3.Range("B6:L" & .Rows.Count).ClearContents
    opRow = 6
    For i = 2 To lRow
        ' Updated check for varenNr5 with multi-entry support
        If varenNr5 <> "" Then
            ' Use Match to verify if current row's value is in the array
            If IsError(Application.Match(Trim(.Range("A" & i)), varenNr5Arr, 0)) Then
                GoTo nextRowPls
            End If
        End If
        
        ' Original checks for other fields (unchanged unless you want multi-entry here too)
        If batchNr5 <> "" And batchNr5 <> Trim(.Range("D" & i)) Then GoTo nextRowPls
        If batchNr7 <> "" And batchNr7 <> Trim(.Range("E" & i)) Then GoTo nextRowPls
        If fremS <> "" And fremS <> Trim(.Range("B" & i)) Then GoTo nextRowPls
        If henS <> "" And henS <> Trim(.Range("C" & i)) Then GoTo nextRowPls
        If antaL <> "" And antaL <> Trim(.Range("G" & i)) Then GoTo nextRowPls
        If varenVan <> "" And varenVan <> Trim(.Range("F" & i)) Then GoTo nextRowPls
        If klinkVar <> "" And klinkVar <> Trim(.Range("H" & i)) Then GoTo nextRowPls
        
        ' Copy matching row to Report sheet
        Sheet3.Range("B" & opRow) = Sheet2.Range("A" & i)
        Sheet3.Range("C" & opRow) = Sheet2.Range("B" & i)
        Sheet3.Range("D" & opRow) = Sheet2.Range("C" & i)
        Sheet3.Range("E" & opRow) = Sheet2.Range("D" & i)
        Sheet3.Range("F" & opRow) = Sheet2.Range("E" & i)
        Sheet3.Range("G" & opRow) = Sheet2.Range("F" & i)
        Sheet3.Range("J" & opRow) = Sheet2.Range("G" & i)
        Sheet3.Range("K" & opRow) = Sheet2.Range("H" & i)
        'Sheet3.Range("L" & opRow) = Sheet2.Range("I" & i)
        opRow = opRow + 1
nextRowPls:
    Next i
End With
Sheet3.Activate
'MsgBox "Udskrivning fuldført. " & opRow - 6 & " resultater fundet."
Unload Me
End Sub

Private Sub txtVaren5_AfterUpdate()
    If Trim(Me.txtVaren5.Value) <> "" Then
        Dim aCell As Range
        ' Note: This only populates txtVarenavn with the first match's value
        ' For multi-entry, you could adjust to concatenate all matching names
        Set aCell = Sheet2.Range("A2:A" & Sheet2.Rows.Count).Find(What:=Split(Trim(Me.txtVaren5.Value), ";")(0), _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False)
        If Not aCell Is Nothing Then
            Me.txtVarenavn.Value = Sheet2.Range("F" & aCell.Row)
        End If
    End If
End Sub

Private Sub CommandButton_Ryd_Indskrivning_Click()
    'Nulstiller felter indeholdende tekst
    '----------------------------------------------------------------
    Me.txtVaren5.Value = ""
    Me.txtBatch5.Value = ""
    Me.txtBatch7.Value = ""
    Me.txtFrems.Value = ""
    Me.txtHens.Value = ""
    Me.txtAntal.Value = ""
    Me.txtVarenavn.Value = ""
    'Nulstiller Klinik knapper
    '----------------------------------------------------------------
    Me.Klinik_JA.Value = False
    Me.Klinik_NEJ.Value = False
    Me.Klinik_VEDIKKE.Value = False
End Sub

Private Sub UserForm_Activate()
    txtBatch5.SetFocus
End Sub

Private Sub UserForm_Click()
End Sub

Key Changes Explained #

1. Multi-Entry Handling for txtVaren5 #

• We split the input string into an array using Split(varenNr5, ";") to separate each entry.
• A loop trims whitespace from each array element to handle inputs like entry12; entry13 (with spaces after semicolons).
• Replaced the direct equality check with Application.Match: if the current row's value isn't found in the array, we skip the row.

2. Minor Cleanup #

• Initialized klinkVar to an empty string to avoid potential errors if no radio button is selected.

3. Extending to Other Fields (Optional) #

If you want multi-entry support for other text boxes (like txtBatch5), replicate the same pattern:

1. Split the input into an array
2. Trim each element
3. Replace the direct equality check with a Match check

Note on txtVaren5_AfterUpdate #

The current sub only populates txtVarenavn with the first matching entry's value. If you need to show all matching names for multi-entry inputs, you'd need to adjust this logic to loop through the array and concatenate results.

内容的提问来源于stack exchange，提问作者Tino Petersson