如何告诉宏使用具有匹配、索引数据的另一个单元格执行匹配、索引公式？答案

【问题标题】：How to tell macro to perform Match, Index formula using another cell with Match, Index data?如何告诉宏使用具有匹配、索引数据的另一个单元格执行匹配、索引公式？
【发布时间】：2017-09-12 09:06:53
【问题描述】：

我有一个 Excel 工作簿，其中包含 2 个主工作表和一个数据输入工作表。

项目负责人：

|Project No  |Asset No    |
|------------|------------|
|P01         |A01         |

资产大师：

|Asset No   |Description   |
|-----------|--------------|
|A01        |Testing       |

对于我的数据输入表，我想使用项目编号作为参考，并使用 VBA 中的索引/匹配公式来搜索其他 2 个字段。在这种情况下：

|Project No  |Asset No   |Description  |
|------------|-----------|-------------|
|P01         |A01        |Testing      |

我还希望数据输入表只更改选定的行，而不是在更改单个单元格时刷新整个表。所以在 VBA 数据输入表中我使用了代码：

Private Sub worksheet_change(ByVal target As Range)

If Not Intersect(target, Range("a9:a9999")) Is Nothing Then
'---------------------------------------------------------------
 With target.Offset(0, 1)
    .FormulaR1C1 = "=IF(ISNA(INDEX(ProjectEntry,MATCH(rc1,ProjectEntry[Project No],FALSE),2)),"""",INDEX(ProjectEntry,MATCH(rc1,ProjectEntry[Project No],FALSE),2))"
    .Value = .Value
 End With

 With target.Offset(0, 2)
    .FormulaR1C1 = "=IF(ISNA(INDEX(AssetMaster,MATCH(rc1,AssetMaster[Asset No],FALSE),2)),"""",INDEX(AssetMaster,MATCH(rc1,AssetMaster[Asset No],FALSE),2))"
    .Value = .Value
 End With

End If

End Sub

当我使用此代码时，只有资产 no 出现，而 description 保持为空。每当我选择的范围内的单元格 (a9:a9999) 的值发生更改时，代码应该在行中执行更改。

这是由于代码限制必须参考 2 个主表，它仅指项目主表，而资产主表被忽略？有没有办法解决这个问题？

【问题讨论】：

根据经验，使用 VBA 编写工作表函数并不是一个好主意。这个布丁的证据就是你几乎卡在第一行代码上。
是的。然而，这只是一个更大的项目的测试平台，该项目正在进行中，以前所有的公式都在工作表中。每当我尝试过滤主表时，这都会导致主服务器严重减速。我发现将公式放在 VBA 中然后让它保存值只会有助于防止这个问题。
你为什么用 VBA 做这个。只需在相关单元格中编写公式即可。如果您不想在单元格中显示错误，请使用 IFERROR(yourlongformula,"")
@Variatus 问题清楚地 说明这是一个需要打破经验法则的特殊情况。（正如 hjh93 针对您的评论所证明的那样。）
我同意你的逻辑。但是，您的要求不是“将公式放入 VBA”。它是使用 VBA 将公式写入工作表。如果下一步是保存由公式计算的值，我的观点将得到证明：让 VBA 计算值并将它们写入工作表。无论如何，我在下面发布了一些代码，如果对您有帮助，我会很高兴。

标签： vba excel

【解决方案1】：

您的第二个公式有错误。它应该是：

 With target.Offset(0, 2)
    .FormulaR1C1 = "=IF(ISNA(INDEX(AssetMaster,MATCH(RC2,AssetMaster[Asset No],FALSE),2)),"""",INDEX(AssetMaster,MATCH(RC2,AssetMaster[Asset No],FALSE),2))"
    .Value = .Value
 End With

您拥有的RC1 应该是RC2（或RC[-1]）。

编辑：

可以在以下代码中看到更好的公式（感谢ExcelinEfendisi）：

Private Sub Worksheet_Change(ByVal Target As Range)

  If Intersect(Target, Range("A9:A9999")) Is Nothing Then Exit Sub
  '---------------------------------------------------------------

  With Target.Offset(0, 1)
    .FormulaR1C1 = "=IFERROR(INDEX(ProjectEntry[Asset No],MATCH(RC[-1],ProjectEntry[Project No],0)),"""")"
    .Value = .Value
  End With
  With Target.Offset(0, 2)
    .FormulaR1C1 = "=IFERROR(INDEX(AssetMaster[Description],MATCH(RC[-1],AssetMaster[Asset No],0)),"""")"
    .Value = .Value
  End With

End Sub

但是，正如许多 cmets 建议的那样，仅刷新已编辑行的最佳方法是在 VBA 中进行计算并将结果写入工作表.

以下代码使用表的ListObject 对象执行此操作：

Private Sub Worksheet_Change(ByVal Target As Range)

  If Intersect(Target, Range("A9:A9999")) Is Nothing Then Exit Sub
  '---------------------------------------------------------------

  Dim Ä As Excel.Application: Set Ä = Excel.Application
  Dim varValue As Variant

  varValue = Ä.Index(Ä.Range("ProjectEntry[Asset No]"), Ä.Match(Target.Value2, Ä.Range("ProjectEntry[Project No]"), 0))
  Target.Offset(0, 1).Value = IIf(IsError(varValue), vbNullString, varValue)
  varValue = Ä.Index(Ä.Range("AssetMaster[Description]"), Ä.Match(varValue, Ä.Range("AssetMaster[Asset No]"), 0))
  Target.Offset(0, 2).Value = IIf(IsError(varValue), vbNullString, varValue)

End Sub

注意使用Application. 而不是WorksheetFunction. 来访问工作表函数。这与使用 Variant 类型变量相结合，使我们能够捕获匹配失败时发生的错误。

【讨论】：

@hjh93 我已经用一些更有用的代码示例更新了答案。

【解决方案2】：

将此代码粘贴到“数据输入”表的代码表中。在我的测试中，我将此表称为“JHJ93”。请在代码中更改此名称。

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' 12 Sept 2017

    If Not Application.Intersect(Target, EntryRange(True)) Is Nothing Then
        ' "True" means: MUST select from the list
        SetValidation Target, ProjectList, True
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 12 Sep 2017

    If Not Application.Intersect(Target, EntryRange) Is Nothing Then
        ' Here you want to call a function which is similar
        ' to "ProjectList" but returns a list of all Assets.
        ' this list you can feed to the Sub "SetValidation" to set
        ' the validation in column B of the Entry Sheet.
        ' Select the cell.
    End If
End Sub

Private Function EntryRange(Optional PlusOneRow As Boolean) As Range
    ' 12 Sep 2017
    ' add one row to the range at the bottom if PlusOneRow is True

    Dim Rl As Long

    With Worksheets("HJH93")            ' this would be your Data Entry sheet
                                        ' please change the name as required
        Rl = .Cells(.Rows.Count, "A").End(xlUp).Row + Abs(PlusOneRow)
        ' start entries on row 2 (first row = captions)
        Rl = Application.Max(Rl, 2)
        Set EntryRange = .Range(.Cells(2, "A"), .Cells(Rl, "A"))
    End With
End Function

Private Function ProjectList() As String
    ' 12 Sep 2017
    ' return the current (unique) list of all projects
    ' comma=separated for use in validation dropdown

    ' if the list becomes quite long you may have to design
    ' a faster method of creating this list

    Dim Fun As String                       ' function return string
    Dim Tmp As String
    Dim Rl As Long
    Dim R As Long

    With Worksheets("Project Master")
        Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
        For R = 2 To Rl                     ' Row 1 is presumed to have a caption
            Tmp = Trim(.Cells(R, "A").Value)
            If InStr(1, Fun, Tmp, vbTextCompare) = 0 Then
                ' presuming that your list separator for validation lists
                ' is a comma
                Fun = Fun & "," & Tmp
            End If
        Next R
    End With
    If Len(Fun) Then ProjectList = Mid(Fun, 2)
End Function

Private Sub SetValidation(Tgt As Range, _
                          DdList As String, _
                          Optional SelectOnly As Boolean, _
                          Optional Del As Boolean)
    ' 12 Sep 2017
    ' Set or delete validation in Tgt

    With Tgt.Validation
        .Delete

        If Not Del Then
            .Add Type:=xlValidateList, Formula1:=DdList
            .InCellDropdown = True
            .ShowInput = True
            .IgnoreBlank = False
            .ShowError = SelectOnly
            If SelectOnly Then
                .ErrorTitle = "Required entry"
                .ErrorMessage = "Please select an existing list item."
            End If
        End If
    End With
End Sub

我已经添加了很多 cmets 让你找到你的方位，但这里还是一个简短的描述：-

当您单击“数据输入”表的“项目”字段（A 列）时，会生成“项目主文件”中所有项目的验证列表。您选择其中一个项目。此选择会触发 Change 事件。该过程应选择 B 列中的单元格，生成类似的资产列表，从中选择资产。我在这里停止了编码，因为在我看来您没有考虑到每个项目应该有很多资产（或者我没有正确理解这个问题）。

但是，在设置了该下拉菜单后，会进行一个触发另一个 Change 事件的选择。该事件必须选择所选资产的描述。您可以为此使用Application.Vlookup，这意味着您可以将函数嵌入到 VBA 中并将结果写入工作表，而不是将公式写入工作表并让 Excel 为您进行搜索。

我在这里开始的这个过程对你来说可能看起来更费力，但相信我，那只是因为你还没有把自己的方法带到痛苦的结局。

【讨论】：