0

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

所以，我可以很容易地用这样的一行“拉”以前的评论

=VLOOKUP(B5,'Database'!A2:E587,6)

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

我想我需要一个 vba 循环。

想法？即使是我可以访问的参考页面也会很棒。

谢谢你。

编辑：供后人参考，蒂姆提供的完整编码解决方案详述如下。

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
4

1 回答 1

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
于 2013-10-07T21:09:08.733 回答