在环路中使用相对参考 (R1C1) 的动态范围选择

Question

我有一个 excel 表(下面的考试摘录(，并希望通过我的 VBA 代码实现以下目标(我是 VBA 的新手(。

• 遍历列 A 中的所有行
• 计算具有相同日期的 E 列中范围的平均值(A 列(
• 生成一个包含行：日期;列：平均值的新表，并在新工作表中创建表。

重要提示：

• 区域可以有不同的行数，具体取决于日期 (A( 的值数 (E(

作为起点，我有以下VBA代码：

1 Sub GotoNewState()
3 Dim i As Integer
4 Dim startRange As Integer
5 i = 0
7 Do
8     i = i + 1
9     If Cells(ActiveCell.Row + i, ActiveCell.Column).Value <> ActiveCell.Value Then
10         Cells(ActiveCell.Row + i, ActiveCell.Column).Select
11        startRange = -(i - 1)
12         'MsgBox startRange
13        ActiveCell.Offset(-1, 5).FormulaR1C1 = "=AVERAGE("R[" & startRange & "]C[-1]":RC[-1])"
14         Exit Do
15    End If
16 Loop
18 End Sub

但是我对 R1C1 表示法的语法有问题，因为我想传递给 R[参数] 的参数返回错误。

我会很高兴对我上面描述的意图的其他解决方案感到高兴。

摘自 Excel：

A          B C   D    E
13.03.2015 1 300 5.00 0
13.03.2015 2 300 5.00 40
13.03.2015 3 300 5.00 4
13.03.2015 4 300 5.00 2
13.03.2015 5 300 5.00 2
13.03.2015 6 300 5.00 22
20.03.2015 6 300 5.00 0
20.03.2015 5 300 5.00 14
20.03.2015 1 300 5.00 1
20.03.2015 2 300 5.00 0
20.03.2015 3 300 5.00 0
20.03.2015 4 300 5.00 0
27.03.2015 3 300 5.00 0
27.03.2015 4 300 5.00 3
27.03.2015 2 300 5.00 15
27.03.2015 6 300 5.00 147
27.03.2015 5 300 5.00 14
27.03.2015 1 300 5.00 0
02.04.2015 1 300 5.00 8
02.04.2015 2 300 5.00 0
02.04.2015 3 300 5.00 63
02.04.2015 4 300 5.00 0
02.04.2015 5 300 5.00 0
02.04.2015 6 300 5.00 3
17.04.2015 1 300 5.00 7
17.04.2015 2 300 5.00 1
17.04.2015 3 300 5.00 19
17.04.2015 4 300 5.00 0
17.04.2015 5 300 5.00 159
17.04.2015 6 300 5.00 84
30.04.2015 1 300 5.00 0
30.04.2015 2 300 5.00 0
30.04.2015 3 300 5.00 2
30.04.2015 3 300 5.00 2
30.04.2015 4 300 5.00 0
30.04.2015 5 300 5.00 182
30.04.2015 6 300 5.00 2
... 

Answer 1

如果您

仍然想在VBA中执行此操作，则

1.在新列中复制列 A 的唯一值

2.然后使用AVERAGEIF公式进行计算

例如：下面的代码从第 A 列复制唯一日期并将其粘贴到第 G 列中AVERAGEIF并使用第 H 列中的公式计算平均值

    Sub getAvg()
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Range("A60000").End(xlUp).Row ' Last Row number in Column A
    'ws.Range("G1").Value = "Dates"
    ws.Range("H1").Value = "Avg"
    ws.Range("A1:A" & lastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("G1"), Unique:=True ' copy unique values using AdvancedFilter 
    lastRowNewTble = ws.Range("G60000").End(xlUp).Row ' Last Row number in Column G
    ws.Range("H2:H" & lastRowNewTble).Formula = "=AVERAGEIF(A2:A" & lastRow & ",G2,E2:E" & lastRow & ")" ' write formula in column G
    End Sub

Answer 2

如果您不想使用过滤器，可以尝试使用循环。此代码将计算范围的平均值并将它们放在 F 列中：

Dim unqDateDict As Scripting.Dictionary
Dim lastRow As Integer
Dim i As Integer
Dim count As Integer
Dim currDate As String
Set unqDateDict = New Scripting.Dictionary
lastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
count = -1
'Fill dictionary with unique dates
For i = 1 To lastRow
    currDate = Range("A" & i).Value
    If Not unqDateDict.Exists(currDate) Then
        unqDateDict.Add currDate, count
        count = count + 1
    End If
Next
'Calculate averages
Dim tempSum As Integer
Dim keyIndex As Integer
Dim loopIndex As Integer
Dim loopCounter As Integer
Dim Key
loopIndex = 1
keyIndex = 1
loopCounter = 0
For Each Key In unqDateDict.Keys
    For i = loopIndex To lastRow
        If CStr(Range("A" & loopIndex).Value) = Key Then
            tempSum = tempSum + Range("E" & loopIndex).Value
            loopIndex = loopIndex + 1
            loopCounter = loopCounter + 1
        Else
            Range("F" & keyIndex) = tempSum / loopCounter
            loopCounter = 0
            tempSum = 0
            keyIndex = keyIndex + 1
            Exit For
        End If
    Next
Next Key

结束子