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

---

这对一个细胞有效。我需要一系列的细胞。例如，假设我需要单元格A21:F40注释中单元格A1:F20的值。我不想复制同一个Sub多次。

如果您更换，它应该可以完成这项工作

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

与

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

输出：

我的代码：

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

---

从您的问题中，我了解到您希望选择一个单元格范围（例如“A1:A5”），然后选择另一个单元格范围（例如“B6:B10”），第一个选定范围的相应值应作为注释放置在第二个选定范围中。这是正确的吗

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

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

---

我对你的建议做了一些修改，非常感谢，这解决了我的问题：

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

---

不幸的是，这在这一行给了我一个运行时错误“1004:

.AddComment Cell.Offset（20，0）.Value

我不确定是否可以像这样将值直接放入注释中。。。谢谢你在这里帮助我！很抱歉，显然我太笨了^^虽然我在正确的表格中有代码，但它不起作用，你能发布你的全部代码吗？谢谢，伙计…你在

范围（“A21:F40”）

中有空单元格吗？我在

范围（“A21:F40”）

中没有空单元格。。。它仍然不起作用，即使我复制你的确切代码，加上我需要它作为一个私人子，因为当A21:F40中的值改变时，注释应该自动改变！对不起，如果我的问题完全是哑巴^^你有任何合并的单元格吗？这几乎是我想要的，但我不想选择单元格的范围，我希望它能自动与特定的单元格范围发生。F.e.始终在B1:B5的注释中显示单元格A1:A5的值！

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