Сохранить ListBox Multiselection в одну ячейку

Question

Я работаю над пользовательской формой, где пользователи могут редактировать записи из списка и сохранять их в указанных c ячейках.

Private Sub CommandButton3_Click()
   Dim lZeile As Long

     If ListBox1.ListIndex = -1 Then Exit Sub

     If Trim(CStr(TextBox_Name.Text)) = "" Then
         MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!"
         Exit Sub
     End If
     lZeile = 2 
     Do While Trim(CStr(Tabelle4.Cells(lZeile, 1).Value)) <> ""
         If ListBox1.Text = Trim(CStr(Tabelle4.Cells(lZeile, 1).Value)) Then

             Tabelle4.Cells(lZeile, 1).Value = Trim(CStr(TextBox_Name.Text))
             Tabelle4.Cells(lZeile, 11).Value = ListBox_Problem.Text
             Tabelle4.Cells(lZeile, 12).Value = TextBox_Problem2.Text
             Tabelle4.Cells(lZeile, 4).Value = ComboBox1.Text
             Tabelle4.Cells(lZeile, 3).Value = ComboBox2.Text
             Tabelle4.Cells(lZeile, 13).Value = TextBox3.Text
             Tabelle4.Cells(lZeile, 14).Value = TextBox4.Text
             If ListBox1.Text <> Trim(CStr(TextBox_Name.Text)) Then
                 Call UserForm_Initialize
                 If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
             End If
             Exit Do
         End If
         lZeile = lZeile + 1
     Loop

End Sub

Теперь у меня есть ListBox, где можно выбрать несколько записей. Я хочу записать выбранные записи в одну ячейку с "," в качестве разделителя.

Я нашел для этого следующий код:

Dim i As Long

    sText = ""
    Range("B34").Value = ""
    With Me.ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                sText = sText & ", " & .List(i)
            End If

Next i
   End With

    sText = Mid(sText, 3)

    If Len(sText) > 0 Then
        Range("B34").Value = sText
    Else
        MsgBox "No selection made.", vbInformation
   End If

Я пытался включить его в свой, но просто не могу заставить его работать. Я не очень хорошо разбираюсь в VBA, и мне было интересно, может ли кто-нибудь мне помочь?

Answer 1

Самый простой способ - поместить ваш код (с небольшими изменениями) в функцию:

Public Function GetCommaSeparatedListBoxItems(ByVal FromListBox As MSForms.ListBox) As String
    Dim sText As String

    With FromListBox
        Dim i As Long
        For i = 0 To .ListCount - 1 'loop through all items in the ListBox
            If .Selected(i) Then 'chech each item if it is selected and if so …
                sText = sText & ", " & .List(i) '… append this item comma delimited to `sText`
            End If
        Next i
    End With

    'since `sText` is empty in the beginning, data will always start with a comma, so removo that
    'example data before:        ", Item 1, Item 2, Item 3"
    sText = Mid$(sText, 3)
    'example data afterwards:    "Item 1, Item 2, Item 3"

    'return the comma separated items in the function
    GetCommaSeparatedListBoxItems = sText

    'Alternatively instead of the lise above you can …
    If Len(sText) > 0 Then 'check if something was selected in the listbox and  …
        GetCommaSeparatedListBoxItems = sText '… return the value
    Else
        MsgBox "No selection made.", vbInformation '… or a error message
    End If
End Function

, которую вы можете легко использовать, например:

Debug.Print GetCommaSeparatedListBoxItems(FromListBox:=Me.ListBox1)

Пример, чтобы записать его в ячейка, в которой вы можете использовать функцию (в своем первом коде), например:

Tabelle4.Cells(lZeile, 14).Value = GetCommaSeparatedListBoxItems(FromListBox:=Me.ListBox1)

, вам просто нужно настроить код Me.ListBox1 для вашего множественного выбора ListBox.