将Excel单元格值转换为注释

Question

我希望Excel自动为一系列单元格创建注释。注释应包含另一个单元格范围的值。这是到目前为止我得到的：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sResult As String

If Union(Target, Range("A18")).Address = Target.Address Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    sResult = "Maximal " & Target.Value


    With Range("I6")
        .ClearComments
        .AddComment
        .Comment.Text Text:=sResult
    End With
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End If
End Sub

这非常适合一个单元格；我的问题是，整个细胞都需要这个。 F.e.假设我在单元格A21：F40的注释中需要单元格A1：F20的值。当然，我不想复制相同的Sub多次。

关于如何解决此问题的任何想法？

Answer 1

如果更换，应该做的工作

With Range("I6")
        .ClearComments
        .AddComment
        .Comment.Text Text:=sResult
    End With

with

    For Each cell In Range("A1", "F20").Cells
    Dim V As Range
    Set V = cell.Offset(20, 0)
    With cell
    .ClearComments
    If Not IsEmpty(V) Then
    .AddComment V.Value
    End If
    End With
   Next

这基本上将忽略所有空单元格。

输出：

<< img src =“ https://image.soinside.com/eyJ1cmwiOiAiaHR0cHM6Ly9pLnN0YWNrLmltZ3VyLmNvbS9XV1BZYS5wbmcifQ==” alt =“在此处输入图像描述”>

我的代码：

Sub TEST()
 For Each cell In Range("A1", "F20").Cells
    Dim V As Range
    Set V = cell.Offset(20, 0)
    With cell
    .ClearComments
    If Not IsEmpty(V) Then
    .AddComment V.Value
    End If
    End With
   Next
End Sub

Answer 2

我对您的建议做了一些调整，非常感谢，这解决了我的问题：

Private Sub Worksheet_Change(ByVal target As Range)


Dim src As Range: Set src = Worksheets("maxleft").Range("C2:K11")
Dim tar As Range: Set tar = Range("I6:Q15")

    For i = 0 To tar.Rows.Count - 1
        For j = 0 To tar.Columns.Count - 1
        Dim sResult As String
        sResult = "Maximal " & Worksheets("maxleft").Cells(src.Row + i, src.Column + j)
        With Cells(tar.Row + i, tar.Column + j)
            .ClearComments
            .AddComment
            .Comment.Text Text:=sResult
        End With
        Next j
    Next i

End Sub

Answer 3

根据您的问题，我知道您想选择一个单元格范围（例如“ A1：A5”），然后选择另一个单元格范围（例如“ B6：B10”），并且第一个选定范围的值应为作为注释放置在secon所选范围中。这是正确的吗？

以下代码检查是否选择了两个长度相等的范围，并将第一个选定范围的值作为注释复制到第二个选定范围：

Private Sub Worksheet_SelectionChange(ByVal target As Range)

If InStr(target.Address, ",") Then
    Dim selected_range() As String
    selected_range = Split(target.Address, ",")

    If Range(selected_range(0)).Rows.Count = Range(selected_range(1)).Rows.Count Then
        Dim src As Range: Set src = Range(selected_range(0))
        Dim tar As Range: Set tar = Range(selected_range(1))

        For i = 0 To src.Rows.Count - 1
            Dim sResult As String
            sResult = "Maximal " & Cells(src.Row + i, src.Column)
            With Cells(tar.Row + i, tar.Column)
                .ClearComments
                .AddComment
                .Comment.Text Text:=sResult
            End With
        Next i
    End If
End If
End Sub