将ListBox中的多个行/列复制到Excel表单中

我需要一个认真的帮助。 下面的代码为一个简单的列表框开箱即用，但问题是我的列表框有7列，我需要复制到Excel。 我知道解决scheme可能很容易，但我不知道如何修改它，使其工作。 现在只复制第一列

Private Sub CopyButton_Click() Dim i As Long Dim ary ReDim ary(0 To 0) With Me.ListBox2 For i = 0 To .ListCount - 1 If .Selected(i) Then ReDim Preserve ary(1 To UBound(ary) + 1) ary(UBound(ary)) = .List(i) End If Next End With Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(ary)).Value _ = Application.Transpose(ary) End Sub 

Answer 1

ListBox列表属性返回列表框中的所有值的数组。

 With Me.ListBox2 Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(.ListCount, .ColumnCount).Value = .List End With 

将所选项目复制到数组中的最简单方法是：

1. 循环通过项目
2. select适合的数组
3. 做第二个循环填充arrays

这将阻止您必须转置arrays。

---

 Private Sub CopyButton_Click() Dim i As Long, j As Long, count As Long Dim ary As Variant With Me.ListBox2 For i = 0 To .ListCount - 1 If .Selected(i) Then count = count + 1 End If Next ReDim ary(1 To count, 1 To .ColumnCount) count = 0 For i = 0 To .ListCount - 1 If .Selected(i) Then count = count + 1 For j = 0 To .ColumnCount - 1 ary(count, j + 1) = .List(i, j) Next End If Next End With Cells(Rows.count, "A").End(xlUp).Offset(1).Resize(UBound(ary, 1), UBound(ary, 2)).Value = ary End Sub