循环遍历两个或更多个单元格以显示序列中的下一个数字作为单元格的新值

我有一个Excel公式,它依赖于两个定义的范围,Interest_Range和Deposit,并且我有两个单元格,它们为公式使用A7(Interest_Range)和A8(Deposit)。 公式'= SUM(B3 / Interest_Range * Deposit)'位于A6中,一旦对两个范围内的每个数字执行公式,结果会logging在另一个表格中,现在我知道如何用一个范围来实现它,寻找允许多个范围的解决scheme。

单一范围的解决scheme:

Sub tgr() Dim wb As Workbook Dim wsData As Worksheet Dim wsDest As Worksheet Dim rInterestCell As Range Dim rDest As Range Set wb = ActiveWorkbook Set wsData = wb.Sheets("Sheet1") Set wsDest = wb.Sheets("Formula Results") For Each rInterestCell In Range("Interest_Range").Cells wsData.Range("A7").Value = rInterestCell.Value 'Put the interest cell value in range A7, which is used by the formula in A6 wsData.Calculate 'Update the formula result based on the new value in A7 Set rDest = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1) If rDest.Row < 6 Then Set rDest = wsDest.Range("A6") 'Guarantee that A6 is the starting cell for the results rDest.Value = wsData.Range("A6").Value 'Put the value only in a new row in the destination sheet Next rInterestCell End Sub 

像这样的东西应该为你工作。 请注意,它在A,B和C列的“公式结果”表中输出。列A结果是使用的兴趣单元格值,B列结果是使用的存储单元格值,C列结果是基于这些值的公式结果两个值。

 Sub tgr() Dim wb As Workbook Dim wsData As Worksheet Dim wsDest As Worksheet Dim rInterestCell As Range Dim rDepositCell As Range Dim rDest As Range Set wb = ActiveWorkbook Set wsData = wb.Sheets("Sheet1") Set wsDest = wb.Sheets("Formula Results") For Each rInterestCell In Range("Interest_Range").Cells wsData.Range("A7").Value = rInterestCell.Value 'Put the interest cell value in range A7, which is used by the formula in A6 For Each rDepositCell In Range("Deposit").Cells wsData.Range("A8").Value = rDepositCell.Value 'Put the deposit cell value in range A8, which is used by the formula in A6 wsData.Calculate 'Update the formula result based on the new values in A7 and A8 'Guarantee that A6 is the starting cell for the results Set rDest = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1) If rDest.Row < 6 Then Set rDest = wsDest.Range("A6") 'Output the interest cell value used, the deposit cell value used, and the formula result with those values rDest.Resize(, 3).Value = Array(rInterestCell.Value, rDepositCell.Value, wsData.Range("A6").Value) Next rDepositCell Next rInterestCell End Sub