Excel中的动态注释

时间:2016-04-06 08:52:24

标签: excel vba excel-vba

我有一个名为“OPL”的工作表。我在column B中有类型,这是一个下拉列表。通过查找公式,我已计算出小时数,并将其存储在column P中。现在,我需要将Column P中的值添加为B的注释。我有一个代码可以按我的意愿执行。但问题是我每次在列表中添加新类型时都需要运行宏。我想要动态地发生这种情况,即只要我添加一个新的类型,就应该自动从column P获取ist各自的值并将其作为注释。我知道我需要通过设置Target在工作表代码中添加此代码,但不知何故我无法实现它。

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

1 个答案:

答案 0 :(得分:0)

要在B或P列中的值发生变化时自动将其添加到附加或更改注释的级别,您将需要Worksheet_Change事件宏。

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列中的多个值后继续存在。