Question

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

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 List Property返回ListBox中所有值的数组。

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

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

循环浏览项目
将数组尺寸标注为适合
填充数组的第二个循环

这将阻止您转置数组。

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

将多个行/列从ListBox复制到Excel工作表

1 个答案: