我有一个包含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被忽略了吗？有没有办法解决这个问题？
答案 0 :(得分：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类型变量相结合，允许我们捕获匹配失败时发生的错误。
答案 1 :(得分：0)
将此代码粘贴到“数据输入”表的代码表中。在我的测试中，我把这张表称为“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对您进行搜索。
我在这里开始的这个过程对你来说似乎更加费力，但是，相信我，那只是因为你还没有采用自己的方法来达到它的痛苦目的。