Question

我在命令按钮上有以下代码，该命令按钮在用户窗体的列表框中初始化，并将值粘贴到“ ThisWorkbook.Worksheets（“ Sub”）“。

这仅适用于一个选择，如果您在列表框中选择多个选择，则只会将第一个值添加到第5列的单元格A8中。

我希望用户能够从列表框中选择多个选项。然后，当他们保存表单时，我希望他们选择的选项作为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

避免使用Select / Active / Selection / ActiveXXX编码模式，而要使用完全限定（至少是工作表的uop）范围引用

如下

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

列表框用户窗体中的多个选择，并将多个列表框值作为一个数组存储到Excel工作表中

1 个答案: