VBA实现列中所有匹配订单号的多数据批量显示问题求助

问题出在你的代码每次匹配到订单号时，直接覆盖了文本框的内容，而非将所有匹配结果累加。要显示全部匹配项，需要先把所有结果拼接成字符串，再统一赋值给文本框。

修改步骤： #

1. 为每个需要展示的字段声明字符串变量，用于累加匹配结果
2. 循环中找到匹配项时，将对应字段内容追加到变量中（用换行符分隔不同记录）
3. 循环结束后，把累加好的字符串赋值给对应的文本框
4. 补充未声明的变量，避免隐式变量错误

修改后的完整代码： #

Public Sub UserForm_Initialize()
    limiter_a = "^#11^"
    limiter_b = "^#12^"
End Sub

Private Sub suchbutton_Click()
    Dim fullstring As String, searchstring As String
    Dim sofoundStr As String, customerfoundStr As String, pickqtyfoundStr As String
    Dim itemnoteStr As String, itemspecialStr As String, batchStr As String
    Dim placeholder1Str As String, placeholder2Str As String, placeholder3Str As String
    Dim ergebnis As String
    Dim j As Long, lastRow As Long
    Dim lenght_a As Long, lenght_b As Long
    Dim booFound As Boolean ' 显式声明变量
    Dim ws As Worksheet ' 显式声明工作表变量
    
    Set ws = ThisWorkbook.Worksheets("INPUT1")
    
    ' 列映射
    Const placeholder1 As String = "D"
    Const placeholder2 As String = "A"
    Const placeholder3 As String = "J"
    Const sonumber As String = "B"
    Const wave As String = "G"
    Const batch As String = "L"
    Const pickqtyfound As String = "N"
    Const itemnote As String = "R"
    Const itemspecial As String = "T"
    
    lenght_a = Len(limiter_a)
    lenght_b = Len(limiter_b)
    
    fullstring = SucheTeilenummer.userinput.Value
    
    openPos = InStr(fullstring, limiter_a)
    closePos = InStr(fullstring, limiter_b)
   
    If openPos > 0 And closePos > 0 Then
        searchstring = Mid(fullstring, openPos + lenght_a, closePos - openPos - lenght_b)
        lastRow = ws.Cells(ws.Rows.Count, sonumber).End(xlUp).Row
        
        ' 初始化结果字符串为空
        sofoundStr = ""
        customerfoundStr = ""
        pickqtyfoundStr = ""
        itemnoteStr = ""
        itemspecialStr = ""
        batchStr = ""
        placeholder1Str = ""
        placeholder2Str = ""
        placeholder3Str = ""
        booFound = False
        
        For j = 2 To lastRow ' 从上到下循环，符合常规阅读顺序
            If ws.Range(sonumber & j).Value = searchstring Then
                booFound = True
                
                ' 追加当前匹配项的内容，用换行分隔
                If sofoundStr <> "" Then sofoundStr = sofoundStr & vbCrLf
                sofoundStr = sofoundStr & ws.Range(sonumber & j).Value
                
                If customerfoundStr <> "" Then customerfoundStr = customerfoundStr & vbCrLf
                customerfoundStr = customerfoundStr & ws.Range(wave & j).Value
                
                If pickqtyfoundStr <> "" Then pickqtyfoundStr = pickqtyfoundStr & vbCrLf
                pickqtyfoundStr = pickqtyfoundStr & ws.Range(pickqtyfound & j).Value
                
                If itemnoteStr <> "" Then itemnoteStr = itemnoteStr & vbCrLf
                itemnoteStr = itemnoteStr & ws.Range(itemnote & j).Value
                
                If itemspecialStr <> "" Then itemspecialStr = itemspecialStr & vbCrLf
                itemspecialStr = itemspecialStr & ws.Range(itemspecial & j).Value
                
                If batchStr <> "" Then batchStr = batchStr & vbCrLf
                batchStr = batchStr & ws.Range(batch & j).Value
                
                If placeholder1Str <> "" Then placeholder1Str = placeholder1Str & vbCrLf
                placeholder1Str = placeholder1Str & ws.Range(placeholder1 & j).Value
                
                If placeholder2Str <> "" Then placeholder2Str = placeholder2Str & vbCrLf
                placeholder2Str = placeholder2Str & ws.Range(placeholder2 & j).Value
                
                If placeholder3Str <> "" Then placeholder3Str = placeholder3Str & vbCrLf
                placeholder3Str = placeholder3Str & ws.Range(placeholder3 & j).Value
            End If
        Next j
        
        ' 将累加后的结果赋值给文本框
        SucheTeilenummer.sofound.Value = sofoundStr
        SucheTeilenummer.customerfound.Value = customerfoundStr
        SucheTeilenummer.pickqtyfound.Value = pickqtyfoundStr
        SucheTeilenummer.itemnote.Value = itemnoteStr
        SucheTeilenummer.itemspecial.Value = itemspecialStr
        SucheTeilenummer.batch.Value = batchStr
        SucheTeilenummer.placeholder1.Value = placeholder1Str
        SucheTeilenummer.placeholder2.Value = placeholder2Str
        SucheTeilenummer.placeholder3.Value = placeholder3Str
        
    Else
        searchstring = "Keine Limiter gefunden"
        SucheTeilenummer.sofound.Value = searchstring
        emptySucheForm
    End If
        
    If Not booFound Then
        SucheTeilenummer.sofound.Value = "Keine passenden Aufträge gefunden"
        emptySucheForm
    End If

    SucheTeilenummer.userinput.Value = ""
    fullstring = ""
    ergebnis = ""
    SucheTeilenummer.userinput.SetFocus
End Sub

Private Sub emptySucheForm()
    SucheTeilenummer.customerfound.Value = ""
    SucheTeilenummer.pickqtyfound.Value = ""
    SucheTeilenummer.itemnote.Value = ""
    SucheTeilenummer.itemspecial.Value = ""
    SucheTeilenummer.batch.Value = ""
    SucheTeilenummer.placeholder1.Value = ""
    SucheTeilenummer.placeholder2.Value = ""
    SucheTeilenummer.placeholder3.Value = ""
End Sub

关键修改点说明： #

• 为每个字段新增了xxxStr变量，用于累加所有匹配结果
• 使用vbCrLf作为不同记录的分隔符，让文本框中每条结果单独一行
• 显式声明了所有变量，避免VBA隐式变量带来的错误
• 调整循环方向为从上到下，更符合数据阅读习惯
• 仅在第一次追加内容时不添加换行符，避免文本框开头出现空行

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