如何将Userform ListBox第2列数据提取到指定单元格并以逗号分隔

原CommandButton1_Click代码会遍历ListBox的整行数据，导致两列内容都被写入单元格，且用换行符分隔，不符合仅提取第2列并以逗号分隔的需求。以下是修正后的代码及说明：

修正后的CommandButton1_Click代码 #

Private Sub CommandButton1_Click()
    Dim rowIndex As Integer
    Dim partNumbers As String
    Dim sht As Worksheet
    
    Set sht = Sheets("New Profile Part Template")
    partNumbers = ""
    
    ' 遍历ListBox的每一行，提取第2列（索引为1，ListBox列从0开始计数）
    For rowIndex = 0 To Me.Results.ListCount - 1
        ' 跳过搜索无结果的无效条目
        If Me.Results.List(rowIndex, 0) <> "Nothing Found" Then
            ' 已有内容时添加逗号分隔符
            If partNumbers <> "" Then
                partNumbers = partNumbers & ", "
            End If
            ' 拼接第2列的零件编号
            partNumbers = partNumbers & Me.Results.List(rowIndex, 1)
        End If
    Next rowIndex
    
    ' 将最终拼接的字符串写入J9单元格
    sht.Cells(9, 10).Value = partNumbers
End Sub

关键修改说明 #

1. 精准提取指定列：放弃原代码的For Each遍历整行逻辑，改用按行索引遍历，通过List(rowIndex, 1)直接获取第2列数据（ListBox的列索引从0开始，第1列对应索引0，第2列对应索引1）。
2. 逗号分隔逻辑：用字符串变量partNumbers逐步拼接内容，仅在已有内容时添加逗号，避免开头出现多余分隔符。
3. 过滤无效条目：增加判断跳过搜索无结果时的"Nothing Found"条目，防止无效内容被写入目标单元格。

完整修正后的VBA代码 #

Option Explicit
' Display All Matches from Search in Userform ListBox
Dim FormEvents As Boolean

Private Sub ClearForm(Except As String)

' Clears the list box and text boxes EXCEPT the text box
' currently having data entered into it

Select Case Except

    Case "FName"
        FormEvents = False
        LName.Value = ""
        Results.Clear
        FormEvents = True

    Case "LName"
        FormEvents = False
        FName.Value = ""
        Results.Clear
        FormEvents = True
        
    Case Else
        FormEvents = False
        FName.Value = ""
        LName.Value = ""
        Results.Clear
        FormEvents = True
        
    End Select

End Sub

Private Sub ClearBtn_Click()

ClearForm ("")

End Sub

Private Sub CloseBtn_Click()

Me.Hide

End Sub

Private Sub FName_Change()

    If FormEvents Then ClearForm ("FName")

End Sub

Private Sub LName_Change()

    If FormEvents Then ClearForm ("LName")

End Sub


Private Sub Results_Click()

End Sub

Private Sub SearchBtn_Click()
    Dim SearchTerm As String
    Dim SearchColumn As String
    Dim RecordRange As Range
    Dim FirstAddress As String
    Dim FirstCell As Range
    Dim RowCount As Integer

    ' Display an error if no search term is entered
    If FName.Value = "" And LName.Value = "" Then
        MsgBox "No search term specified", vbCritical + vbOKOnly
        Exit Sub
    End If

    ' Work out what is being searched for
    If FName.Value <> "" Then
        SearchTerm = FName.Value
        SearchColumn = "Service Part"
    End If

    If LName.Value <> "" Then
        SearchTerm = LName.Value
        SearchColumn = "Part Number"
    End If

    Results.Clear

        ' Only search in the relevant table column i.e. if somone is searching Service Part Name
        ' only search in the Service Part column
        With Sheet3.Range("Table1[" & SearchColumn & "]")

            ' Find the first match
            Set RecordRange = .Find(SearchTerm, LookIn:=xlValues)

            ' If a match has been found
            If Not RecordRange Is Nothing Then

            FirstAddress = RecordRange.Address
            RowCount = 0

            Do
            
                ' Set the first cell in the row of the matching value
                Set FirstCell = Sheet3.Range("A" & RecordRange.Row)
                
                ' Add matching record to List Box
                Results.AddItem
                Results.List(RowCount, 0) = FirstCell(1, 1)
                Results.List(RowCount, 1) = FirstCell(1, 2)
                
                RowCount = RowCount + 1
                
                ' Look for next match
                Set RecordRange = .FindNext(RecordRange)

                ' When no further matches are found, exit the sub
                If RecordRange Is Nothing Then
                    Exit Sub
                End If

            ' Keep looking while unique matches are found
            Loop While RecordRange.Address <> FirstAddress

        Else
        
            ' If you get here, no matches were found
            Results.AddItem
            Results.List(RowCount, 0) = "Nothing Found"
        
        End If
        
    End With
End Sub

Private Sub CommandButton1_Click()
    Dim rowIndex As Integer
    Dim partNumbers As String
    Dim sht As Worksheet
    
    Set sht = Sheets("New Profile Part Template")
    partNumbers = ""
    
    ' 遍历ListBox的每一行，提取第2列（索引为1，ListBox列从0开始计数）
    For rowIndex = 0 To Me.Results.ListCount - 1
        ' 跳过搜索无结果的无效条目
        If Me.Results.List(rowIndex, 0) <> "Nothing Found" Then
            ' 已有内容时添加逗号分隔符
            If partNumbers <> "" Then
                partNumbers = partNumbers & ", "
            End If
            ' 拼接第2列的零件编号
            partNumbers = partNumbers & Me.Results.List(rowIndex, 1)
        End If
    Next rowIndex
    
    ' 将最终拼接的字符串写入J9单元格
    sht.Cells(9, 10).Value = partNumbers
End Sub


Private Sub UserForm_Initialize()

    FormEvents = True

End Sub

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