将注释添加到Vlookup数据库

时间:2013-10-07 20:25:39

标签: excel vba excel-vba

我正在使用vlookup从数据库中提取。但是这里有一个问题,我想要一个可编辑的评论部分,它将更新数据库本身。

所以,我可以用

这样的行轻松“拉”前面的评论
=VLOOKUP(B5,'Database'!A2:E587,6)

但是,现在,我想在该行添加信息。例如,假设该行当前显示“是橙色并闻起来像脚”,但现在提起记录的用户想要添加“它的形状像蝙蝠”

我想我需要一个vba循环。

想法?即使是我可以去的参考页面也会很棒。

谢谢。

编辑:为了后人的参考,Tim提供的完整编码解决方案详述如下。

Private Sub WorkSheet_Change(ByVal Target As Range)
    Dim retrieve As Range, update As Range

    Set retrieve = Application.Intersect(Me.Range("B5,B19"), Target)
    Set update = Application.Intersect(Me.Range("H5,H19"), Target)

    If Not retrieve Is Nothing Then
        Retrieve_Comments Targ:=retrieve
    ElseIf Not update Is Nothing Then
        Update_Comments update
    End If
End Sub

Private Sub Retrieve_Comments(ByRef Targ As Range)

    Dim c As Range, id, f As Range, cmt

    On Error GoTo haveError
    Application.EnableEvents = False 'need to disable events so you don't trigger the update sub...
    For Each c In Targ.Cells
        id = c.Value
        Set f = Sheets("Database").Columns(1).Find(id, lookat:=xlWhole, LookIn:=xlValues)
        If Not f Is Nothing Then
            cmt = f.Offset(0, 5).Value
        Else
            cmt = "???"
        End If
        c.Offset(0, 6).Value = cmt
    Next c

haveError:
    Application.EnableEvents = True

End Sub

Sub Update_Comments(rng As Range)
    Dim f As Range, id, cmt

    'no need to disable events here, since you're updating a different sheet
    For Each c In rng.Cells
        id = c.EntireRow.Cells(2).Value
        cmt = c.Value
        Set f = Sheets("Database").Columns(1).Find(id, lookat:=xlWhole, LookIn:=xlValues)
        If Not f Is Nothing Then
            f.Offset(0, 5).Value = cmt
        End If

    Next c

End Sub

1 个答案:

答案 0 :(得分:1)

裸骨概述:

Sub AddToComment()
    Dim f as Range, id, cmt

    id = selection.cells(1).entirerow.cells(1).value  ' "key" value
    cmt = selection.cells(1).entirerow.cells(5).value ' new additional comment

    Set f = sheets("database").columns(1).find(id, _
                     lookin:=xlValues,lookat:=xlwhole)
    if not f is nothing then
        with f.entirerow.cells(5)
            .value=.value & " " & cmt
        end with
    else
        msgbox "Key value '" & id & "' not found!" 
    end if

end sub