Excel VBA - For Each 循环没有通过每个单元格运行

Question

我目前面临的问题是，当我尝试执行脚本时，我的“for each”循环没有移动到我定义的范围内的每个单元格的后续单元格。数据的上下文如下：

我有 3 列数据。 L 列包含员工，K 列包含经理，J 列包含副总裁。包含经理和 VP 的 K & J 列未完全填充 - 因此，我想使用 VBA 脚本和索引匹配来填充所有单元格并将员工与经理与 VP 匹配。

我创建了一个参考表，其中我已将所有员工填充到经理再到董事，并将此表命名为“表 4”。然后，我使用下面的 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

我觉得索引匹配公式肯定有问题，因为匹配单元格“L583”在每次循环运行时都不会移动到下一个单元格；但是，我不知道如何解决它。我也不知道还可能缺少什么。代码当前正在执行，但它停留在一个单元格上。

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

Answer 1

问题是您只为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")

您应该将公式应用于范围内的所有单元格

Range("K2:K2000").Formula = "=INDEX(Table4[[#All],[MGRS]], MATCH(L2,Table4[[#All],[EMPS]],0))"

更新：动态范围

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)

更新：

使用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

Answer 2

“L583”没有改变，因为你没有告诉它。下面的代码应该随着单元格地址的变化而改变引用。

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