我正在使用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
答案 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