从Array快速填充Excel单元格

我从外部数据工具生成数组,现在想用数组中的数据填充单元格。 我写了下面的代码。

With ThisWorkbook.Worksheets("Data") Lastrow = .Cells(.Rows.count, 2).End(xlUp).Row For i = LBound(Price) To UBound(Price) .Cells((Lastrow + 1), 1) = Price(i) .Cells((Lastrow + 1), 2) = Quantity(i) Lastrow = Lastrow + 1 Next i End With 

所有的数组长度相同,我有大约25个奇数组来处理。 代码工作正常,但我面临的问题是速度。 我花了大约5-6个小时的时间来填充一次,大约3000个arrays的长度。 请build议你最好的方法。 谢谢。

根据您的问题,您有不同数据(例如Price,Quantity,SomeOtherArray)的数组(25)数目。 根据我上面的评论。

 Option Explicit Public Sub GetData() Dim ws As Worksheet Dim LastRow As Long Dim arrPrice As Variant Dim arrQty As Variant Set ws = Sheets(3) '-- starts at zero index arrPrice = Array(50, 60, 70, 75) arrQty = Array(250, 100, 50, 200) '-- change columns as per your needs LastRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row '-- UBound + 1 is because the array starts at zero index above ws.Range("B1").Offset(LastRow).Resize(UBound(arrPrice)+1).Value = Application.Transpose(arrPrice) ws.Range("B1").Offset(LastRow, 1).Resize(UBound(arrQty)+1).Value = Application.Transpose(arrQty) End Sub 

在这里输入图像说明

这是一个如何填充到一个没有循环的数组范围的例子:

 Sub PopulateFromArray() Dim MyArr As Variant MyArr = Array("Hello", "World", "This is some", "Text") Range("A1").Resize(UBound(MyArr) + 1, 1).Formula = Application.Transpose(MyArr) End Sub 

我们正在使用resize来调整范围,使用数组的上边界填充。 我们添加一个,因为它是基于0的选项。我们转置数组是因为数据的性质,数据会穿过,我们需要它下去。 如果我们想要跨行而不是行,我们需要将它转换为这样:

 Application.Transpose(Application.Transpose(MyArr)) 
 With ThisWorkbook.Worksheets("Data") NextRow = .Cells(.Rows.count, 2).End(xlUp).Row + 1 num = UBound(Price) - LBound(Price) .Range(.Cells(NextRow, 1), .Cells(NextRow + num, 1)) = Application.Transpose(Price) .Range(.Cells(NextRow, 2), .Cells(NextRow + num, 2)) = Application.Transpose(Quantity) End With 

你可以将数组转储到工作表范围,就像这样:

 range("A1:B5").value = myArray 

你可以通过交互来填充一个数组:

 dim myArray as variant myArray = range("A1:B5").value 

我非常频繁地使用这个方法,我很less使用工作表上的数据,我更喜欢把它放到数组中,然后使用数组。

要将N行的范围填充M列,请将数据放入相同大小的二维数组中,然后将该数组分配给范围的Value属性。

 ReDim varValues(1 To lngRowCount, 1 To lngColCount) 

要么

 ReDim varValues(0 To lngRowCount - 1, 0 To lngColCount - 1) 

我认为你可以处理填充数组。 然后:

 Set rngTheRange = 'I presume you can handle this, too rngTheRange.Value = varValues 

这是一个使用这种技术来填充当前select的值为0到N-1的示例,其中N是select中的单元格数量:

 Option Explicit Public Sub X() Dim rngCurrent As Range Dim lngRows As Long Dim lngCols As Long Dim lngR As Long Dim lngC As Long Dim varValues() As Variant Set rngCurrent = Selection lngRows = rngCurrent.Rows.Count lngCols = rngCurrent.Columns.Count ReDim varValues(0 To lngRows - 1, 0 To lngCols - 1) As Variant For lngR = 0 To lngRows - 1 For lngC = 0 To lngCols - 1 varValues(lngR, lngC) = lngR * lngCols + lngC Next Next rngCurrent.Value = varValues End Sub