VBA 基于列表框插入多行数据

Question

对于所选列表框的每一行，我想在列表框中选择的每个数据的下一个空白行中插入数据，一个新的复制行，但来自文本框的文本必须在所有行中均等复制，下面的代码只在一行中复制了文本

Private sub button1_click()
Dim rw  as integer
Dim ws as worksheets
Set worksheets(“Sheet1”)
Rw = ws.cells.find(what:=“*”, searchorder:=xlrows, searchdirection:=xlprevious, lookin:xlvalues).row + 1
Ws.cells(rw, 3).value = me.textbox1.value
Ws.cells(rw, 5).value = me.listbox1.value
End sub

请帮帮我

Answer 1

我创建了一个新的 Workbook 和一个新的 UserForm 以及一个 ListBox、TextBox 和 CommandButton，所有这些都使用了本示例的默认名称.

Option Explicit
____________________________________________________________________________________

Private Sub CommandButton1_Click()

Dim NextBlankRow As Long
Dim TargetRange As Range
Dim ListBoxItem As Long
Dim SelectedItemsArray As Variant
Dim ArrayElementCounter As Long

ArrayElementCounter = 0

With Me.ListBox1
ReDim SelectedItemsArray(0 To .ListCount - 1)
    For ListBoxItem = 0 To .ListCount - 1
        If .Selected(ListBoxItem) Then
            SelectedItemsArray(ArrayElementCounter) = .List(ListBoxItem)
            ArrayElementCounter = ArrayElementCounter + 1
        End If
    Next ListBoxItem
End With

ReDim Preserve SelectedItemsArray(0 To ArrayElementCounter - 1)

With ThisWorkbook.Sheets("Sheet1")
    NextBlankRow = .Cells(Rows.Count, 3).End(xlUp).Row + 1
    Set TargetRange = .Range("C" & NextBlankRow & ":C" & NextBlankRow + UBound(SelectedItemsArray))
End With

Dim TargetCell As Range

ArrayElementCounter = 0
For Each TargetCell In TargetRange
    TargetCell.Value = Me.TextBox1.Value
    TargetCell.Offset(0, 2).Value = SelectedItemsArray(ArrayElementCounter)
    ArrayElementCounter = ArrayElementCounter + 1
Next TargetCell

End Sub

____________________________________________________________________________________

Private Sub UserForm_Initialize()

Dim ListBoxItemArray As Variant

ListBoxItemArray = Array("Listbox Item 1", "Listbox Item 2", "Listbox Item 3")

Dim ItemToAdd As Long

For ItemToAdd = LBound(ListBoxItemArray) To UBound(ListBoxItemArray)
    Me.ListBox1.AddItem (ListBoxItemArray(ItemToAdd))
Next ItemToAdd

End Sub

以下是输入和输出的屏幕截图：

数据selected/entered到UserForm

[

输出到工作表

解释：

出于我的示例的目的，Private Sub UserForm_Initialize() 事件填充了 ListBox - 当涉及到您的代码时，您可以忽略它，但我觉得有必要包括我填充 [=19 的方式=] 以及什么值。

Private Sub CommandButton1_Click() 事件代码分为 4 个主要部分（在声明变量后开始）：

With Me.LisBox1...End With

我们在这里做的第一件事是使用 ReDim 语句设置数组大小。 UpperBound 或数组的限制设置为 ListCount 属性减 1，即 returns 1 减去 ListBox 中的项目数。这确保我们的数组足够大以容纳所有列表框项目值，例如，如果它们都被选中，但是动态地这样做，这样您就不会浪费内存使用不明确的数字来将来证明您的代码，如 100 当你可能只有 30 件物品时。如果添加或删除项目，数组总是正确的大小。

我们减 1 的原因是我将数组的 Option Base 声明为 0，这意味着它开始于（或 Lower Bound 是）0 而不是 1。请参阅Option Base Statement 了解更多信息。

接下来我们遍历每个 ListBox 项目并评估它是否是 Selected。如果是，我们使用 List() 属性将该项目的值分配给数组。有关它们的工作原理，请参阅 For...Next loops for more info on how they work and see Using Arrays。

现在我们有 SelectedItemsArray() 完整的列表框中每个选定项目的值。

ReDim Preserve SelectedItemsArray(0 To ArrayElementCounter - 1)

与之前非常相似，我们正在设置数组的大小，但这次包括语句的 Preserve 部分。这意味着我们可以调整数组的大小但保留其中的所有当前值 - 如果我们不使用 Preserve 数组将调整大小但会丢失所有值。我们再次动态设置 Upper Bound 以将数组的大小调整为所选项目的数量。（再次查看 Using Arrays 有关数组大小等的信息）

With ThisWorkbook.Sheets("Sheet1")...End With

在这个 With 块中，我们找到 Column C 最后使用的行并将该行 + 1（因此它引用下一个空白行）分配给 LastUsedRow。我们还定义了我们想要使用数组的 LastUsedRow 变量和 Upper Bound 动态写入数据的范围。这样做是为了在下一段代码中写入适量的单元格。

For Each TargetCell In TargetRange...Next TargetCell

另一个循环，但这次使用 For Each...Next。与 For...Next 循环非常相似，但这个循环遍历数组或集合的元素 - 在这种情况下，我们将遍历 TargetRange 中的每个单元格。

对于范围内的每个单元格，记住我们的范围设置为从下一个空白行开始的 Column C，TextBox 值写入 C 列，每个 ListBox 项目值我们数组中的元素被写入 E 列。随着循环迭代，ArrayItemCounter 递增，确保每次循环时将下一个数组元素写入 E 列。

VBA 基于列表框插入多行数据

VBA Insert Multiple Row data based on a listbox

excel

vba

listbox

copy

解释：