0

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
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 に答える