Excel VBA - For Each循环未在每个单元格中运行

Question

我目前正面临一个问题，即我的每个人都会遇到这样的问题。当我尝试执行脚本时，循环不会移动到我已定义的范围内的每个单元格的后续单元格。数据的上下文如下：

我有3列数据。列L包含员工，列K包含管理员，列J包含VP。专栏K＆amp;包含J的管理器和VP没有完全填充 - 因此，我想使用VBA脚本＆amp;索引匹配以填充所有单元格并将员工与经理匹配到副总裁。

我创建了一个参考表，其中我已将所有员工填充到管理人员和董事，并将此表命名为＃34;表4＆＃34;。然后，我使用下面的VBA代码尝试运行K列中的每个单元格来填充管理器：

Sub FillVPs()
Dim FillRng As Range, FillRng1 As Range, cell As Range

Set FillRng = Range("J2:J2000")
Set FillRng1 = Range("K2:K2000")

For Each cell In FillRng1
    If cell.Value = "" Then
        ActiveCell.Formula = _
    "=INDEX(Table4[[#All],[MGRS]], MATCH(L583,Table4[[#All],[EMPS]],0))"

 End If
  Next cell
End Sub

我觉得索引匹配公式作为匹配单元＆＃34; L583＆＃34;每次通过循环时都不会移动到下一个单元格;但是，我不知道如何解决它。我也不知道还有什么可能遗漏。代码当前正在执行，但它仍然停留在一个单元格上。

非常感谢任何帮助，如有必要，我将确保澄清。提前谢谢。

Answer 1

＆＃34; L583＆＃34;没有改变，因为你没有告诉它。下面的代码应该在单元格地址更改时更改引用。

Range.Address Property

Sub FillVPs()
Dim FillRng As Range, FillRng1 As Range, cell As Range

Set FillRng = Range("J2:J2000")
Set FillRng1 = Range("K2:K2000")

For Each cell In FillRng1
    If cell.Value = "" Then
        cell.Formula = _
    "=INDEX(Table4[[#All],[MGRS]], MATCH(" & cell.Offset(0,1).Address() & ",Table4[[#All],[EMPS]],0))"

 End If
  Next cell
End Sub

Answer 2

问题是您只是为ActiveCell设置公式。

ActiveCell.Formula = _
"=INDEX(Table4[[#All],[MGRS]], MATCH(L583,Table4[[#All],[EMPS]],0))"

这应该解决它

cell.Formula = _
"=INDEX(Table4[[#All],[MGRS]], MATCH(L583,Table4[[#All],[EMPS]],0))"

您可能需要调整L583。除非您填写所有单元格，否则它将无法正确填充。

这些范围可能应该改变，以便它们是动态的。

Set FillRng = Range("J2:J2000")
Set FillRng1 = Range("K2:K2000")

您应该将公式应用于范围

中的所有单元格

  

范围（＆＃34; K2：K2000＆＃34;）。公式=＆＃34; = INDEX（表4 [[#All]，[MGRS]]，MATCH（L2，表4 [[#All]，[ EMPS]，0））＆＃34;

更新：动态范围

Excel中的每个表都应至少有一列包含表中每条记录的条目。此列应用于定义动态范围的高度。

例如，如果列A始终具有条目，并且您要为列K创建动态范围

lastrow = Range("A" & Rows.Count).End(xlUp).Row
Set rng1 = Range("K2:K" & lastrow)

或

Set rng1 = Range("A2:A" & Rows.Count).End(xlUp).Offset(0, 10)

UPDATE：

使用Range.SpecialCells(xlCellTypeBlanks)定位空白单元格。您必须添加错误处理程序，因为如果找不到空白单元格，SpecialCells将抛出错误。

On Error Resume Next
Set rng1 = Range("A2:A" & Rows.Count).End(xlUp).Offset(0, 10).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng1 Is Nothing Then
    MsgBox "There were no Blank Cels Found", vbInformation, "Action Cancelled"
    Exit Sub
End If