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响应非常慢,将它们复制到工作表
如何加快此代码的速度?
答案 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