列表框选定值粘贴到工作表

时间:2014-05-08 09:26:29

标签: arrays excel vba excel-vba split

 i=19

With ListBox1
    'clearing previous values from sheet
    range(Cells(i + 2, 1).Address & ":" & Cells(endRwow, 7).Address).ClearContents

    ListBoxArrSelected = vbNullString

    For y = 0 To .ListCount - 1
        If .Selected(y) Then
            ' concatenate all selected strings
            ListBoxArrSelected = ListBoxArrSelected & "~" & ListBox1.List(y)
        End If
    Next y

    ' fill array with concatenated all selected strings spliting to rows
    ListBoxArrSplitToRows = Split(ListBoxArrSelected, "~")

    For UR = 1 To UBound(ListBoxArrSplitToRows, 1) + 1
        ' fill array with concatenated all selected strings spliting to colomuns
        ListBoxArrSplitToCell = Split(ListBoxArrSplitToRows(UR - 1), "·")

        For URc = 1 To UBound(ListBoxArrSplitToCell, 1) + 1
            'paste to sheet
            Cells(i + UR, 1).value = timeStr
            Cells(i + UR, URc + 1).value = ListBoxArrSplitToCell(URc - 1)
        Next URc
    Next UR
End With

然后在列表框中选择> 100字段excel响应非常慢,将它们复制到工作表

如何加快此代码的速度?

2 个答案:

答案 0 :(得分:1)

您可以使用以下内容减少单元格写入次数:

i = 19

  With ListBox1
    Range(Cells(i + 2, 1), Cells(endRwow, 7)).ClearContents

    ListBoxArrSelected = vbNullString

        For y = 0 To .ListCount - 1
            If .Selected(y) Then
                ListBoxArrSelected = ListBoxArrSelected & "~" & ListBox1.List(y)
            End If
        Next y
            ListBoxArrSplitToRows = Split(ListBoxArrSelected, "~")

            Cells(i + 1, 1).Resize(UBound(ListBoxArrSplitToRows, 1) + 1).Value = timeStr
            For UR = 1 To UBound(ListBoxArrSplitToRows, 1) + 1
                ListBoxArrSplitToCell = Split(ListBoxArrSplitToRows(UR - 1), "·")
                Cells(i + UR, 2).Resize(, UBound(ListBoxArrSplitToCell, 1) + 1).Value = ListBoxArrSplitToCell
            Next UR

    End With

如果列表框的每一行都有相同数量的分隔项,则可以创建一个数组数组,然后在一次写操作中将其输出到工作表。代码将是这样的:

Dim ListBoxArrSplitToRows()
Dim counter                     As Long
Dim columnCount                 As Long
i = 19

Range(Cells(i + 2, 1), Cells(endRwow, 7)).ClearContents

With ListBox1

    ReDim ListBoxArrSplitToRows(.ListCount - 1)

    For y = 1 To .ListCount
        If .Selected(y - 1) Then
            ' load subarray into array
            ListBoxArrSplitToRows(counter) = Split(.List(y - 1), "·")
            counter = counter + 1
        End If
    Next y
End With

' resize array to used extent
ReDim Preserve ListBoxArrSplitToRows(counter - 1)
' get column count using first subarray
columnCount = UBound(ListBoxArrSplitToRows(0)) + 1
Cells(i + 1, "B").Resize(counter, columnCount).Value = Application.Index(ListBoxArrSplitToRows, 0, 0)

答案 1 :(得分:1)

或者只是Cell(i + 1," B")。Resize(counter,columnCount).Value = ListBoxArrSplitToRows