将二维范围(i,j)的存储值重新计算N次到二维范围(N,i * j)

我有一个二维范围(我,j)是这样的:

1 2 3 4 5 6 7 8 9 0 

我想复制并粘贴到另一个表如下:

 1 6 2 7 3 8 4 9 5 0 

我需要多次重新计算2-dim范围,并将结果存储在另一个表单中,其中每行存储一个迭代。 现在我使用两个for循环将所有计算存储在数组(N,i * j)中,然后将所有迭代粘贴到另一个表中。

有没有更快的方法来做到这一点? 当前代码:

 Dim a(1 To 100, 1 To 10) As Double For iter = 1 To 100 Calculate For i = 1 To 2 For j = 1 To 5 a(iter, i + j * (i - 1)) = Cells(i, j) Next j Next i Next iter With Sheets("results") Range(.Cells(1, 1), .Cells(100, 2 * 5)) = a End With 

UPD:在每个“计算”初始范围变化的值之后。 这个例子只是说明了2-d范围的值应该如何存储在一行中。

UPD2:更正了我目前的代码

尝试这个。 它给你所需的输出,只使用两个循环(而不是三个)

 ' For loop Dim i As Long, j As Long ' Initalise array Dim tmp(1 To 100, 1 To 10) As Variant 'Loop through all rows in already initalised array For i = LBound(tmp, 1) To UBound(tmp, 1) 'Calculate to get updated row contents Calculate 'Loop through each column in row 'The Round and divided by two is to calculate the number of columns concerned instead of the number in the array For j = LBound(tmp, 2) To Round((UBound(tmp, 2) + 0.1) / 2) 'First row tmp(i, (j + j - 1)) = Cells(1, j).Value2 'Second row ' If incase the array is initalised to an odd number otherwise this would be out of range If j * 2 <= UBound(tmp, 2) Then tmp(i, j * 2) = Cells(2, j).Value2 End If Next j Next i ' Write back to sheet With Sheets("results").Cells(1, 1) Range(.Offset(0, 0), .Offset(UBound(tmp, 1) - 1, UBound(tmp, 2) - 1)) = tmp End With 

像这样的东西应该为你工作:

 Sub tgr() Dim rData As Range Dim iter As Long Dim lNumIterations As Long Dim i As Long, j As Long, k As Long Dim a() As Double Dim aAfterCalc As Variant Set rData = Sheets("Data").Range("A1:E2") lNumIterations = 100 ReDim a(1 To lNumIterations, 1 To rData.Rows.Count * rData.Columns.Count) For iter = 1 To lNumIterations k = 0 Calculate aAfterCalc = rData.Value For j = 1 To rData.Columns.Count For i = 1 To rData.Rows.Count k = k + 1 a(iter, k) = aAfterCalc(i, j) Next i Next j Next iter Sheets("results").Range("A1").Resize(lNumIterations, UBound(a, 2)).Value = a End Sub 

不知道我得到你,但是这样的事情

 Sub test() Dim a() As Variant Dim b() As Variant a = Range("a1:e1").Value b = Range("a2:e2").Value For x = 1 To 5 Range("H1").Offset(0, x).Value = a(1, x) Range("H1").Offset(0, 5 + x).Value = b(1, x) Next x End Sub 
 Private Sub this() Dim this As Variant, counter As Long, that As Integer, arr() As Variant counter = 0 this = ThisWorkbook.Sheets("Sheet3").UsedRange For i = LBound(this, 2) To UBound(this, 2) counter = counter + 2 ReDim Preserve arr(1 To 1, 1 To counter) arr(1, counter - 1) = this(1, i) arr(1, counter) = this(2, i) Next i ThisWorkbook.Sheets("Sheet4").Range(ThisWorkbook.Sheets("Sheet4").Cells(1, 1), ThisWorkbook.Sheets("Sheet4").Cells(1, counter)).Value2 = arr End Sub