如何通过VBA填充以下模式的公式,但将公式保留在单元格中



我想在各行中添加具有以下模式的公式。有没有一种简单的VBA方法?

Cell AB16 = SUM(AC9:AC13)/SUM(AB9:AB13)
Cell AC16 = SUM(AD8:AD12)/SUM(AC8:AC12) 
Cell AD16 = SUM(AE7:AE11)/SUM(AD7:AD11)
Cell AE16 = SUM(AF6:AF10)/SUM(AE6:AE10)
Cell AF16 = SUM(AG5:AG9)/SUM(AF5:AF9)

等等。

我尝试使用.formula函数提取公式,并尝试创建单独的循环来吸收字母中的递增模式和数字中的递减模式。在这里,我面临的问题是,直到A到z,我可以将循环从ascii 65增加到90。超过z,它变得乏味,因为我需要跳到AA。

有没有更好的方法可以通过VBA实现上面的跨行公式填充,但我希望公式格式为上面的Sum(xxx:xxx(/Sum(yyy:yyy(?限制是,我不能在这些单元格中的宏中运行硬编码的数字。此外,在这些单元格中也不能有偏移公式。这些单元格只能采用Sum(xxx:xxx(/Sum(yyy:yyy(格式。

与Excel一样,您不需要关心字母表。行和列实际上是有编号的,字母只出现在最后,只是为了方便您。您可以忽略它们,并使用R1C1(Excel的母语:(说话

Dim target As Range
Set target = Range("AB16:AF16")
Dim start_offset As Long
start_offset = 2
Dim c As Range
For Each c In target
c.FormulaR1C1 = "=SUM(R[-" & (start_offset + 5) & "]C[1]:R[-" & (start_offset + 1) & "]C[1])/SUM(R[-" & (start_offset + 5) & "]C:R[-" & (start_offset + 1) & "]C)"
start_offset = start_offset + 1
Next

编写公式(VBA(

Option Explicit
Sub WriteSumsDivision()

Const rAddress As String = "AB16:AF16"
Const rOffset As Long = 22
Const cSize As Long = 5

Dim ws As Worksheet: Set ws = ActiveSheet ' improve
Dim rrg As Range: Set rrg = ws.Range(rAddress)
Dim fCol As Long: fCol = rrg.Cells(1).Column
Dim cCount As Long: cCount = rrg.Columns.Count
Dim cOffset As Long: cOffset = rOffset - fCol
Dim MaxOffset As Long: MaxOffset = cSize - rOffset + 1

Dim rCell As Range
Dim rArr As Variant: ReDim rArr(1 To cCount)
Dim cFormula As String
Dim c As Long

For Each rCell In rrg.Cells
c = c + 1
cOffset = cOffset - 1
If cOffset > MaxOffset Then
cFormula = "=SUM(" & rCell.Offset(cOffset, 1) _
.Resize(cSize).Address(0, 0) & ")/SUM(" _
& rCell.Offset(cOffset).Resize(cSize).Address(0, 0) & ")"
rArr(c) = cFormula
Else
Debug.Print "Limit hit."
Exit For
End If
Next rCell
rrg.Formula = rArr
End Sub

最新更新