VBA查找并在单元格更改时插入

时间:2013-01-10 15:38:40

标签: excel vba

主要工作表:

学生|等级|目标代码|目标文本

吉姆| A | Code1 |这是与Code1

对应的文本

查找表,在名为“目标”的工作表中定义为“名称”“TargetCodes”:

Code1 |这是与Code1

对应的文本

Code2 |这是与Code2

对应的文本

我需要一些VBA,以便在更改任何记录的TargetCode字段时,相应的文本以文本形式放入“目标文本”列。我无法在目标文本列中使用LOOKUP,因为文本需要是可编辑的,如果您尝试编辑它,您只需编辑LOOKUP公式。非常感谢任何形式的帮助。

我已经通过挑选StackExchange的其他部分将一些代码整合在一起:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell_to_test As Range, cells_changed As Range
Dim result As String
Dim sheet As Worksheet

    Set cells_changed = Target(1, 1)
    Set cell_to_test = Range("D2")

    If Not Intersect(cells_changed, cell_to_test) Is Nothing Then 

        Set sheet = ActiveWorkbook.Sheets("Persuasive Speaking")
        Set TargetSheet = ActiveWorkbook.Sheets("Targets")
        result = Application.WorksheetFunction.Lookup(sheet.Range("D2"),     sheet.Range("WritingTargets"))
        MsgBox ("Test")
    End If
End Sub-

但是我得到对象'_Worksheet'的错误“方法'范围'失败了......

非常感谢任何帮助。

1 个答案:

答案 0 :(得分:1)

Private Sub Worksheet_Change(ByVal Target As Range)

Const COL_IDS As Long = 3
Const COL_TARG_TEXT As Long = 4

Dim rngIds As Range, c As Range, val
Dim rngTable As Range, tmp, result

    On Error GoTo haveError

    Set rngIds = Application.Intersect(Target, Target.Parent.Columns(COL_IDS))

    If Not rngIds Is Nothing Then
        Set rngTable = ThisWorkbook.Sheets("Targets").Range("TargetCodes")
        For Each c In rngIds.Cells
            tmp = Trim(c.Value)
            If Len(tmp) > 0 Then
                val = Application.VLookup(tmp, rngTable, 2, False)
                'disable events to avoid re-triggering this sub                 
                Application.EnableEvents = False
                c.EntireRow.Cells(COL_TARG_TEXT).Value = _
                                    IIf(IsError(val), "Not found!", val)
                Application.EnableEvents = True
            End If
        Next c
    End If

    Exit Sub

haveError:
    'MsgBox Err.Description
    Application.EnableEvents = True

End Sub