Question

我有一个包含2张主表和一张数据输入表的Excel工作簿。

项目管理员：

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

资产大师：

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

对于我的数据输入表，我想使用Project No作为我的参考，并使用VBA中的Index / Match公式来搜索其他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

当我使用此代码时，只有资产没有出现，而描述仍为空。每当我选择的范围（a9：a9999）中的单元格的值发生变化时，代码应该在行中执行更改。

这是由于代码限制必须引用2个主表单，它只引用Project Master而Asset Master被忽略了吗？有没有办法解决这个问题？

Answer 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

但是，正如很多评论所暗示的那样，刷新已编辑行的最佳方法是在VBA中执行计算并将结果写入工作表

以下代码使用表格＆＃39; 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类型变量相结合，允许我们捕获匹配失败时发生的错误。

Answer 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

我为你找到了很多评论，但是这里有一个简短的描述： -

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

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

我在这里开始的这个过程对你来说似乎更加费力，但是，相信我，那只是因为你还没有采用自己的方法来达到它的痛苦目的。

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

2 个答案: