使用偏移来复制公式下拉一列。

huangapple go评论77阅读模式
英文:

Using offset to copy formula down a column

问题

我正在尝试应用一个公式,需要引用公式单元格左侧的几个单元格和上方的几个单元格,然后在整个列中应用该公式多行。

我尝试使用偏移函数来实现结果,但我没有得到期望的结果。

Sub ResultAchievedIsNotAsRequired()

Dim variableA As Long
variableA = Worksheets("DATA").Range("D7").Value

Dim LeftRow As Long
LeftRow = ActiveCell.Offset(0, -1).Value

Dim Upperrow As Long
Upperrow = ActiveCell.Offset(-1, 0).Value

Dim q As Long
Worksheet("MyCalculation").Range("B4").Select

For q = 4 To 50
    Selection.Value = (ActiveCell.Offset(0, -1).Value * (2 / (VariableA + 1)) + ActiveCell.Offset(-1, 0).Value * (1 - (2 / (VariableA + 1))))
    ActiveCell.Offset(1, 0).Activate
Next

End Sub

抱歉,我的互联网连接断了几天。我应该更精确地表述问题。

  • 单元格 B3 的值应该等于 => A1 到 A3 的平均值。
  • 单元格 B4 应该计算:
    (A4 单元格的值*(2/(8+1))+ B3 单元格的值*(1-2/(8+1)))
  • 单元格 B5 应该计算:
    (A5 单元格的值*(2/(8+1))+ B4 单元格的值*(1-2/(8+1)))
  • 单元格 B6 应该计算:
    (A6 单元格的值*(2/(8+1))+ B5 单元格的值*(1-2/(8+1)))
  • 依此类推... 向下计算列

附上的屏幕截图仅用于提供类似问题的示例,尽管列引用的公式不同。我甚至尝试将值更改为公式,但结果相同,值不会自动调整。

我以文本格式粘贴我的公式,按建议。通过"期望的结果",我是指VBA计算的数字与使用公式计算的数字不同。VBA计算是错误的。

经过一些搜索,我在思考是否使用具有Redim preserve的数组可以解决这个问题,以任何方式?

如@Faneduru解决的问题是在使用"Activecell"而不是"rng"的地方,而不是在使用"select"。

英文:

使用偏移来复制公式下拉一列。

I am trying to apply a formula where I need to refer to a few cells to the left of the formula cell and a few cells to the up and apply the formula down the column for quite a few rows.

I am trying to achieve the result by using offset function, but I am not getting the desired result.

Sub ResultAchievedIsNotAsRequired()

Dim variableA As Long
variableA = Worksheets("DATA").Range("D7").Value

Dim LeftRow As Long
LeftRow = ActiveCell.Offset(0, -1).Value

Dim Upperrow As Long
Upperrow = ActiveCell.Offset(-1, 0).Value

Dim q As Long
Worksheet("MyCalculation").Range("B4").Select

For q = 4 To 50
    Selection.Value = (ActiveCell.Offset(0, -1).Value * (2 / (VariableA + 1)) + ActiveCell.Offset(-1, 0).Value * (1 - (2 / (VariableA + 1))))
    ActiveCell.Offset(1, 0).Activate
Next

End Sub

====
I am really sorry my internet connection for down for a couple of days.
I should have phrased the question a bit more precisely.

  • Cell B3 should have value equaling =>average of A1 to A3.
  • Cell B4 should calculate :
    (value of cell A4*(2/(8+1))+ value of cell B3*(1-2/(8+1)))
  • Cell B5 should calculate :
    (value of cell A5*(2/(8+1))+ value of cell B4*(1-2/(8+1)))
  • Cell B6 should calculate :
    (value of cell A6*(2/(8+1))+ value of cell B5*(1-2/(8+1)))
  • and so on….down the column

The screen shot attached was just to give an example of a similar problem where calculations were almost of the same nature though, column referred to in formula were different.
I even tried changing value to formula, but results are the same and values are not auto-adjusted.

I am pasting my formula in text format as adviced.By 'desired result' I mean the numbers calculated by VBA are not the same as calculated by using formula. VBA calculations are faulty.

The image above was only indicative of a similar case.

After googling a bit, I am having thoughts if using an array with Redim preserve can solve the issue, in any way?

As solved by @Faneduru The issue was with using 'Activecell' in place of 'rng' and not with 'select'.

答案1

得分: 1

请尝试以下代码:

Sub ResultAchieved()
 Dim variableA As Long, sh As Worksheet, q As Long, rng As Range
 variableA = Worksheets("DATA").Range("D7").Value

 Set sh = Worksheets("MyCalculation")
 For q = 4 To 50
    Set rng = sh.Range("B" & q)
    rng.Value = (rng.Offset(0, -1).Value * (2 / (variableA + 1)) + _
               rng.Offset(-1, 0).Value * (1 - (2 / (variableA + 1))))
 Next q
End Sub
英文:

Try this code, please:

Sub ResultAchieved()
 Dim variableA As Long, sh As Worksheet, q As Long, rng As Range
 variableA = Worksheets("DATA").Range("D7").Value

 Set sh = Worksheets("MyCalculation")
 For q = 4 To 50 ' sh.Cells(sh.Rows.count, "A").End(xlUp).Row
    Set rng = sh.Range("B" & q)
    rng.value = (rng.Offset(0, -1).Value * (2 / (variableA + 1)) + _
               rng.Offset(-1, 0).Value * (1 - (2 / (variableA + 1))))
 Next q
End Sub

huangapple
  • 本文由 发表于 2020年1月6日 19:20:26
  • 转载请务必保留本文链接:https://go.coder-hub.com/59611195.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定