Vba Excel中的动态注释

我有一张名为“OPL”的工作表。我在下拉列表的

列B

中有类型。通过查找公式，我已经计算了那里的小时数，并将其存储在

列P

中。现在我需要将

列P

中的值作为注释添加到

B

。我有一个代码，可以按照我的要求来做。但问题是每次我向列表中添加新类型时都需要运行宏。我希望这是动态发生的，即一旦我添加了一个新类型，它应该自动从

列P

中获取ist相应的值，并将其作为注释。我知道我需要通过设置

目标

将此代码添加到工作表代码中，但不知何故我无法实现它

Public Sub addComment()

    Dim row As Integer
    Dim oldComment As String

    'Set start row
    row = 6

    With Sheets("OPL")

        'Do until "B" cell is blank
        Do While .Range("B" & row) <> ""

            'If "P" cell is not blank
            If .Range("P" & row) <> "" Then


                'Insert comment for "A" with old if exist
                .Range("B" & row).addComment ("Dauer : " & .Range("P" & row).Value)

            End If

            'Increase row
            row = row + 1

        Loop

    End With

End Sub

Public Sub addComment（）
将行设置为整数
将注释设置为字符串
'设置起始行
行=6
附页（“OPL”）
'直到“B”单元格为空
Do While.Range（“B”行和“行”）
'如果“P”单元格不为空
如果.Range（“P”和row）”，则
'为“A”插入注释，如果存在旧注释
.Range（“B”和行）.addComment（“Dauer:”和.Range（“P”和行）.Value）
如果结束
"增行"
行=行+1
环
以
端接头

要在B列或p列中的值更改时自动添加或更改注释，需要一个事件宏

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("B:B,P:P"), Range("6:1048576")) Is Nothing Then
        On Error GoTo bm_Safe_Exit
        Application.EnableEvents = False
        Dim bp As Range
        For Each bp In Intersect(Target, Range("B:B,P:P"), Range("6:1048576"))
            Range("B" & bp.Row).ClearComments
            If Not IsEmpty(Cells(bp.Row, "B")) And CBool(Len(Cells(bp.Row, "P").Value)) Then
                Range("B" & bp.Row).AddComment _
                  Text:="Dauer : " & Range("P" & bp.Row).Value
            End If
        Next bp
    End If

bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

---

在粘贴或清除B列和/或p列中的多个值后，这些值应仍然有效。

若要在B列或p列中的值更改时自动附加或更改注释，您将需要一个事件宏

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("B:B,P:P"), Range("6:1048576")) Is Nothing Then
        On Error GoTo bm_Safe_Exit
        Application.EnableEvents = False
        Dim bp As Range
        For Each bp In Intersect(Target, Range("B:B,P:P"), Range("6:1048576"))
            Range("B" & bp.Row).ClearComments
            If Not IsEmpty(Cells(bp.Row, "B")) And CBool(Len(Cells(bp.Row, "P").Value)) Then
                Range("B" & bp.Row).AddComment _
                  Text:="Dauer : " & Range("P" & bp.Row).Value
            End If
        Next bp
    End If

bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

---

在粘贴或清除B列和/或p列中的多个值后，应该不会出现这种情况。

谢谢您的帮助。我也试着做一些类似的事情，这种方法在我看来很好，但在应用这段代码之后，不知何故什么也没有发生。我还试图通过在第一个If条件之后放置一个

msgbox“comin here”

来进行调试，这意味着每当我更改B列中的值时，消息都应该出现。但不幸的是，它不属于工作表的代码表，而不是模块代码表b）它只在b列和P列中有值时添加注释，目标（更改的单元格）位于第6行或更高的位置，我已经对它进行了测试，它在添加和删除值方面都很有效。我正在根据B列的值通过VLookup计算P列的值。这意味着，一旦我选择了一个新类型，我就会在P列中得到相应的值。P列中的值不是预先存储的，所以这是动态计算问题还是其他问题@吉佩德诺。虽然公式不会触发工作表的更改，但更改B列中的值会导致错误。我仍然怀疑你把它放错了地方，因为你还没有确认你把它放在了工作表的代码表中。好吧，好吧……我想我知道发生了什么。当

列P

中的值更改时，调试工作正常。但它应该反过来发生。我需要交换范围吗？谢谢你的帮助。我也试着做一些类似的事情，这种方法在我看来很好，但在应用这段代码之后，不知何故什么也没有发生。我还试图通过在第一个If条件之后放置一个

msgbox“comin here”

来进行调试，这意味着每当我更改B列中的值时，消息都应该出现。但不幸的是，它不属于工作表的代码表，而不是模块代码表b）它只在b列和P列中有值时添加注释，目标（更改的单元格）位于第6行或更高的位置，我已经对它进行了测试，它在添加和删除值方面都很有效。我正在根据B列的值通过VLookup计算P列的值。这意味着，一旦我选择了一个新类型，我就会在P列中得到相应的值。P列中的值不是预先存储的，所以这是动态计算问题还是其他问题@吉佩德诺。虽然公式不会触发工作表的更改，但更改B列中的值会导致错误。我仍然怀疑你把它放错了地方，因为你还没有确认你把它放在了工作表的代码表中。好吧，好吧……我想我知道发生了什么。当

列P

中的值更改时，调试工作正常。但它应该反过来发生。我需要交换范围吗？