在Excel VBA中对范围内的每个单元格调用函数（涉及插入行，因此范围会改变）答案

【问题标题】：call function to each cell in a range (involve insert rows, so the range will change) in Excel VBA在Excel VBA中对范围内的每个单元格调用函数（涉及插入行，因此范围会改变）
【发布时间】：2016-07-05 22:00:20
【问题描述】：

我正在学习 VBA，但遇到了一些问题

我拥有的是日期列表： picture1

我想做的就是这样每天加三顿饭 picture2

我已经录制了一个可以实现这个的宏：

Sub InsertMeal()
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.Offset(0, 2).Select
    ActiveCell.FormulaR1C1 = "Breakfast"
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "Lunch"
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "Dinner"
    ActiveCell.Offset(-2, -2).Range("A1:A3").Select
    Selection.Merge
End Sub

现在我想编写一个宏，将这个 InsertMeal() 函数应用于所选范围内的每个单元格。

这是我写的

Sub ApplyToAll()
    For Each c In ActiveCell.CurrentRegion.Cells
        Call InsertMeal
        ActiveCell.Offset(1, 0).Select
    Next
End Sub

问题是，因为我每次都插入行，所以 For 循环不能正常工作。循环永远不会结束。现在我不知道如何“保持范围”以使循环正常工作。

如果您知道如何执行此操作，请提供帮助。谢谢，真的很感激。

【问题讨论】：

不相关但你有InsertMeal 然后InsertTime？编辑：为什么不在InsertMeal 中使用循环？
对不起，我更改了第一个函数名称，但是当我粘贴到 stackoverflow 时忘记更改第二个函数名称。请考虑这两个相同。
第二个问题没意见？如果没有原因，不要调用另一个子，只需循环原始子。
但它仍然不会结束循环。我认为这是因为ActiveCell.CurrentRegion.Cells 总是在变化？
请编辑 OP/不要将代码放入 cmets。编辑：是的，您想要一个更好的循环，例如for。

标签： vba excel

【解决方案1】：

这里真的不需要两个函数。要修改循环以执行您需要的操作，b/c 您正在添加行，您需要在另一个循环中嵌套一个小循环，该循环在您的 3、Breakfast、Lunch 和 @ 块中工作987654324@.

代码看起来像这样，但您必须修改范围以适合您的目的。例如

Sub dave()
  Dim i As Long
  Dim lastrow As Long
  Dim j As Long

   lastrow = Cells(Rows.Count, 1).End(xlUp).Row * 3
   x = Array("Breakfast", "Lunch", "Dinner")

  For i = 1 To lastrow
     Cells(i + 1, 1).Resize(2).EntireRow.Insert
     For j = 1 To 3
       Cells(i + j - 1, 3).Value = x(j - 1)
     Next j
       Cells(i, 1).Resize(3).Merge: i = i + 2
  Next i
End Sub

顺便说一句，在添加行时，lastrow 需要乘以 3，因此原始 lastrow 在完成时不会反映实际的最后一行。

【讨论】：

完美运行！你给了我很多启发！谢谢凯洛伦。现在我知道如何使用End(xlUp)、Resize() 等。我还改进了您的代码，以便可以将其应用于任何选定的区域。随时发表评论：D
另一种方法是从最后一行倒退到第一行 - For i = lastrow to 1 Step -1。插入行不会影响循环。

【解决方案2】：

Sub RelativeFunc()
    col = ActiveCell.Column
    lastrow = Cells(Rows.Count, col).End(xlUp).Row
    firstrow = Cells(1, col).End(xlDown).Row
    rownum = lastrow - firstrow + 1
    frownum = rownum * 3

    x = Array("Breakfast", "Lunch", "Dinner")

    For i = 1 To frownum
        Cells(i + firstrow, col).Resize(2).EntireRow.Insert
        For j = 1 To 3
            Cells(firstrow + i - 1 + j - 1, col + 1).Value = x(j - 1)
        Next j
        Cells(firstrow + i - 1, col).Resize(3).Merge
        i = i + 2
    Next i
End Sub

【讨论】：