Несколько вариантов выбора в пользовательской форме Listbox и сохранение нескольких значений списка в виде одного массива в таблице Excel

Question

У меня есть следующий код на командной кнопке, которая инициализируется в списке в пользовательской форме и вставляет значение в «ThisWorkbook.Worksheets (« Sub »)».

Это работает только с одним выбором, иесли вы выберете несколько вариантов выбора в списке, он только добавит первое значение в ячейку A8 в столбце 5.

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

Private Sub cmdadd_Click()
    On Error Resume Next
    Set wks = ThisWorkbook.Worksheets("Sub")
    wks.Activate
    Dim i As Integer
    ActiveSheet.Range("A8").Select
    i = 1
    Do Until ActiveCell.Value = Empty
        ActiveCell.Offset(1, 0).Select 'move down 1 row
        i = i + 1 'keep a count of the ID for later use
    Loop
    'Populate the new data values into the 'Sub' worksheet.
    ActiveCell.Value = i 'Next ID number
    'Populate the new data values into the 'Sub' worksheet.
    ActiveCell.Offset(0, 1).Value = Me.txtls.Text 'set col B
    ActiveCell.Offset(0, 2).Value = Me.txtPr.Text
    ActiveCell.Offset(0, 3).Value = Me.cbolo.Text

    Dim intOffset As Integer
    Dim strVal As String
    Dim selRange As Range

    Set selRange = Selection
    For i = 0 To ListBox1.ListCount - 1
     If ListBox1.Selected(i) = True Then
      If strApps = "" Then
       strApps = ListBox1.List(i)
       intOffset = i
       strVal = ActiveCell.Offset(0, 4).Value 'set col E
      Else
       strApps = strApps & ";" & ListBox1.List(i)
       intOffset = i
       strVal = strVal & ";" & ActiveCell.Offset(0, 4).Value 'set col E
     End If
    End If
   Next
End Sub


Private Sub UserForm_Initialize()

    Me.ListBox1.AddItem "A"
    Me.ListBox1.AddItem "3"
    Me.ListBox1.AddItem "S"
    Me.ListBox1.AddItem "2"
    Me.ListBox1.AddItem "S"
End Sub

Answer 1

Избегайте выбора / Active / Selection / ActiveXXX шаблона кодирования и полагайтесь на полностью квалифицированные (по крайней мере, на лист) ссылки на диапазон

следующим образом

Option Explicit

Private Sub cmdadd_Click()
    Dim wks As Worksheet
    Set wks = ThisWorkbook.Worksheets("Sub")

    Dim i As Long

    With wks.Range("A8") ' reference "sub" worksheet cell A8
        i = 1
        Do Until .Offset(i - 1).Value = Empty ' check for referenced cell current row offset empty value
            i = i + 1 'keep a count of the ID for later use
        Loop

        'Populate the new data values into the 'Sub' worksheet.
        With .Offset(i - 1) ' reference referenced cell row offset to first empty cell
            'Populate the new data values into the 'Sub' worksheet.
            .Value = i ' set col A with next ID number
            .Offset(0, 1).Value = Me.txtls.Text 'set col B
            .Offset(0, 2).Value = Me.txtPr.Text 'set col C
            .Offset(0, 3).Value = Me.cbolo.Text 'set col D

            Dim strApps As String
            For i = 0 To ListBox1.ListCount - 1
                If ListBox1.Selected(i) Then strApps = strApps & ListBox1.List(i) & ", " ' update 'strApps' string with listbox selected items separated by a comma and a space
            Next
            If strApps <> "" Then .Offset(0, 4).Value = Left(strApps, Len(strApps) - 2) ' if any listbox selected values, write 'strApps' in col E
        End With
    End With
End Sub