Question

问题详情

下面的代码存储数组funds()中计算的结果，并为所选范围重复该过程。到最后，将有一个具有170个值的一维数组。我需要从每个循环的某个点访问数组，以使用不同的值填充新行。

详细问题

我遇到的核心问题是将该数组打印到工作簿上由10行乘17列组成的范围。

对于选定范围内的每个单元格，我设法让它连续一行＃34;循环退出，但现在它用相同的初始数组值填充新行！

这是当前的输出：

我尝试了什么？

我尝试过Redim但是被例子的长度所淹没。
我尝试过手动复制和粘贴，但觉得这是作弊......
我研究过如何通过复制过程删除元素..

总的来说，我确信有一个简单的方法，每个人都知道如何使用！但它是什么？

简而言之......

每个循环删除最初的17个值，然后将下一个17个数组值打印到范围内的新行。重复10次。

代码

Option Explicit
Public funds(0 To 170) As Variant

Sub cumulativeperformance()

    Dim selectedrange As Range
    Dim cell As Range
    Dim value1 As Double
    Dim Value2 As Long
    Dim i, x, d, c As Integer
    Dim total(0 To 170) As Double

    'Copy the table to report
    Worksheets("Data").Range("C3:T13").Copy
    Sheets("Report").Range("B39").PasteSpecial
    Worksheets("Data").Range("B3:T13").Copy
    Sheets("Report").Range("A39").PasteSpecial xlPasteValues

    'Repeat 9 times
    c = 39
    For d = 0 To 9

        c = c + 1
        Set selectedrange = Worksheets("Report").Range(Cells(c, 3), Cells(c, 19))
        For Each cell In selectedrange

            value1 = cell.Value

            'get the value of cell to the left of current cell
            Value2 = cell.Offset(0, -1).Value

            'get the difference to previous month
            value1 = value1 / Value2 - 1

            'assign result + 1 to array
            total(x) = value1 + 1

            'If initial fund slot is 0, then store first result of calculation in that slot
            If i = 0 Then
                funds(i) = total(0) - 1
            ElseIf i > 0 Then
                'Do calculation on remaining values and store in fund array
                funds(i) = (funds(i - 1) + 1) * total(i) - 1
            End If

            'MsgBox "cumulative performance: " & funds(I) & " Cell address: " & cell.Address
            i = i + 1
            x = x + 1

        Next

        'Write from one dimensional Array To The worksheet
        Dim Destination As Range
        Dim j As Integer

        Set Destination = Range(Cells(c, 3), Cells(c, 3)) 'starts at
        Set Destination = Destination.Resize(1, 17) 'UBound(funds))
        Destination.Value = funds

        'MsgBox "Hi there"

    Next d

    'one-off commands in here
    Range("C40:S49").NumberFormat = "0.00%"
    Call portfoliomay

End Sub

Answer 1

目标范围和源数组应具有相同的尺寸，以便能够正确分配值，如Ron Rosenfeld所评论。这可以通过使用一维数组一次仅重复一次行array(columns) 10次，或者完整目标范围（10x17）array(rows, columns)的二维数组来实现。

方法＃1：1维数组

使用包含17个值的1维数组，逐行操作，一次一行。最初将数组声明为动态数组Dim funds() ...，这样您就可以轻松地重置它。然后在每个ReDim funds(16) ...迭代的开头设置其基于零的长度For d = 0 To 9。其余的代码将保持不变。使用此方法，您的原始目标分配应按预期Destination.Value = funds（或使用等效的较短语句Cells(c, 3).Resize(1, 17) = funds）工作。

方法＃2：二维数组

您可以将资金声明为基于零的二维数组Dim funds(9, 16) ...。但是，没有直接的方法将数据逐行放入。 在您的计算循环结束后 Cells(40, 3).Resize(10, 17) = funds ，目的地分配将是整个范围。您还需要调整funds指令以指示行funds(d, i) = ...。这可能是放入工作表中数据的最有效方式（性能明智），因为将数据放入单元格相对耗时。

*要使用二维数组逐行执行此操作，您必须使用类似于此处所述的解决方法return an entire row of a multidimensional array in VBA to a one dimensional array。

其他调整

您需要调整total数组以使其与funds具有相同的维度和指令，或者调整i和x计算。要调整i和x并保留total，请在i = 0次迭代开始时添加For d，并仅使用total(x)。

Answer 2

OP确认后，

已编辑他的目标是优化代码（请参阅最后的内容）

我正在添加一个不同的“味道”的数组/范围使用并显示一些可能的代码增强

Variant变量为数组

不需要Dim或Redim任何数组，只需将ita声明为纯Variant变量，并使用将承载最终结果的范围值填充它

有点像
```
funds = repRng.Value
```
其中repRng是您要填充Range数组本身的“报告”表单的funds
减少变量

根本不需要一个完整的阵列。只需使用简单的Double变量
Dim
```
Dim i, x, d, c As Integer
```
会导致从i类型声明x，d和Variant变量，而c类型只声明Integer

要将所有那些变量声明为整数，您必须输入：
```
Dim i As Integer, x As Integer, d As Integer, c As Integer
```
但我们会少用它们
减少代码

因为你正在分配
```
value1 = value1 / Value2 - 1
```
然后
```
total(x) = value1 + 1
```
您可以将这两个语句合并到单个
中
```
total(x) = value1 / Value2
```
对于上述内容，我们将改为：
```
total = value1 / Value2
```

复制/粘贴

这些陈述：

Worksheets("Data").Range("C3:T13").Copy
Sheets("Report").Range("B39").PasteSpecial
Worksheets("Data").Range("B3:T13").Copy
Sheets("Report").Range("A39").PasteSpecial xlPasteValues

实际上与：

相同

Worksheets("Data").Range("B3:T13").Copy
Sheets("Report").Range("A39").PasteSpecial xlPasteValues

也可以写成：

With Worksheets("Data").Range("B3:T13")
    Sheets("Report").Range("A39").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With

这种方法既减少了时间（对于这么小的范围也不是问题）并且不使用剪贴板（至少你需要注意释放Application.CutCopyMode = False）

对于上述内容，此语句也将用于初始化repRng Range变量

With Worksheets("Data").Range("B3:T13")
    Set repRng = Sheets("Report").Range("A39").Resize(.Rows.Count, .Columns.Count) '<--| define the range where to paste data
    repRng.Value = .Value '<--|  paste data
End With

减少变量（第2部分）

您的d变量仅用于迭代之前复制和粘贴的行，但您使用的是其跨度的硬编码值，然后使其相对于另一个硬编码的引用行索引（{{ 1}}）

你最好利用consistente对你实际处理范围的引用，比如（伪代码）
```
c = 39
```
其中Dim oneRow As Range For Each oneRow In repRng.Rows '<--| loop through rows of your relevant data range For Each cell In oneRow.Cells '<--| loop through cells of the current data range row 'code Next cell Next row是一个repRng对象，引用了您要循环的工作表“报告”的相关单元格

最终结果将是以下代码：

Range

进一步优化将避免Option Explicit Public funds As Variant '<--| declare the simple Variant variable that will be "turned" into an array as long as we'll initialize it to a "Range" values Sub cumulativeperformance() Dim cell As Range, repRng As Range, oneRow As Range Dim value1 As Double, total As Double Dim value2 As Long Dim iRow As Long, jCol As Long '<--| better use "Long" instead of "Integer" when dealing with numbers that cope with Excel rows indexs 'Copy table values to report With Worksheets("Data").Range("B3:T13") Set repRng = Sheets("Report").Range("A39").Resize(.Rows.Count, .Columns.Count) '<--| define the range where to paste data repRng.Value = .Value '<--| paste data End With With repRng Set repRng = .Offset(1, 2).Resize(.Rows.Count - 1, .Columns.Count - 2) '<--| redefine the relevant data range to loop through End With With repRng '<--| assume your relevant data range as reference funds = .Value '<--| have funds array properly dimensioned by filling it with relevant data pasted values: they'll be rewritten in following loops For Each oneRow In .Rows '<--| loop through rows of your relevant data range iRow = iRow + 1 '<--| update array row counter jCol = 1 '<--|for each new row restart array column counter For Each cell In oneRow.Cells '<--| loop through cells of the current data range row value1 = cell.Value '<--|get the value of current cell value2 = cell.Offset(0, -1).Value '<--|get the value of cell to the left of current cell total = value1 / value2 '<--|evaluate the ratio If jCol = 1 Then funds(iRow, jCol) = total - 1 '<--| If initial fund slot is 1, then store first result of calculation in that slot Else funds(iRow, jCol) = (funds(iRow, jCol - 1) + 1) * total - 1 '<--| Do calculation on remaining values and store in fundS array End If jCol = jCol + 1 'update array column counter Next cell Next oneRow .Value = funds '<--| fill your relevant data range with funds values .NumberFormat = "0.00%" End With ' Call portfoliomay End Sub检查每一行，因为它没有达到某种未知条件：我们确定每个新行都将以列索引1开始

所以，对于每一行，我们都可以

在其初始栏目中采取行动：
```
If jCol = 1 Then
```
依赖于特定的funds(iRow, 1) = GetTotal(oneRow.Cells(1, 1)) - 1 'evaluate funds current row first slot (column)功能
```
GetTotal()
```
我们收集了代码以计算Function GetTotal(cell As Range) As Double Dim value1 As Double Dim value2 As Long value1 = cell.Value '<--|get the value of current cell value2 = cell.Offset(0, -1).Value '<--|get the value of cell to the left of current cell GetTotal = value1 / value2 '<--|evaluate the ratio End Function值“附加”到单个total
为后续列进行计算
```
cell
```
利用相同的jCol = 2 '<--|for each new row restart array column counter For Each cell In Range(oneRow.Cells(1, 2), oneRow.Cells(1, oneRow.Cells.Count)) '<--| evaluate funds current row remaining slots funds(iRow, jCol) = (funds(iRow, jCol - 1) + 1) * GetTotal(cell) - 1 jCol = jCol + 1 'update array column counter Next cell功能

最后更新的代码是：

GetTotal()

一些最后的（？）笔记：

一个。 Option Explicit Public funds As Variant '<--| declare the simple Variant variable that will be "turned" into an array as long as we'll initialize it to a "Range" values Sub cumulativeperformance() Dim cell As Range, repRng As Range, oneRow As Range Dim iRow As Long, jCol As Long '<--| better use "Long" instead of "Integer" when dealing with numbers that cope with Excel rows indexs 'Copy table values to report With Worksheets("Data").Range("B3:T13") Set repRng = Sheets("Report").Range("A39").Resize(.Rows.Count, .Columns.Count) '<--| define the range where to paste data repRng.Value = .Value '<--| paste data End With With repRng Set repRng = .Offset(1, 2).Resize(.Rows.Count - 1, .Columns.Count - 2) '<--| redefine the relevant data range to loop through End With With repRng '<--| assume your relevant data range as reference funds = .Value '<--| have funds array properly dimensioned by filling it with relevant data pasted values: they'll be rewritten in following loops For Each oneRow In .Rows '<--| loop through rows of your relevant data range iRow = iRow + 1 '<--| update array row counter funds(iRow, 1) = GetTotal(oneRow.Cells(1, 1)) - 1 'evaluate funds current row first slot (column) jCol = 2 '<--|for each new row restart array column counter For Each cell In Range(oneRow.Cells(1, 2), oneRow.Cells(1, oneRow.Cells.Count)) '<--| evaluate funds current row remaining slots funds(iRow, jCol) = (funds(iRow, jCol - 1) + 1) * GetTotal(cell) - 1 jCol = jCol + 1 'update array column counter Next cell Next oneRow .Value = funds '<--| fill your relevant data range with funds values .NumberFormat = "0.00%" End With ' Call portfoliomay End Sub Function GetTotal(cell As Range) As Double Dim value1 As Double Dim value2 As Long value1 = cell.Value '<--|get the value of current cell value2 = cell.Offset(0, -1).Value '<--|get the value of cell to the left of current cell GetTotal = value1 / value2 '<--|evaluate the ratio End Function变量

这些用于在不同模块中的不同子/函数之间共享变量

但使用它们通常是一种不好的做法，最好将这些变量放在子/函数参数中以便在需要的地方携带它们

使用问题中的代码，没有使用Public的其他子/函数，因此最好将其声明转换为cumulativeperformance（）：

funds

B中。简化GetTotal（）

Option Explicit

Sub cumulativeperformance()

    Dim funds As Variant '<--| declare the simple Variant variable that will be "turned" into an array as long as we'll initialize it to a "Range" values
    Dim cell As Range, repRng As Range, oneRow As Range

如何从每个循环的某个点访问一个数组？

2 个答案:

方法＃1：1维数组

方法＃2：二维数组

其他调整