Excel单元格值注释

我希望Excel自动创build一系列单元格的注释。 注释应该包含另一个单元格区域的值。 这是我到目前为止：

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多次。

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

Answer 1

它应该做你的工作，如果你更换

 With Range("I6") .ClearComments .AddComment .Comment.Text Text:=sResult End 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 

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

输出：

我的代码：

 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

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

 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

从你的问题，我明白，你要select的单元格范围（如“A1：A5”），然后select其他范围的单元格（如“B6：B10”），第一个选定的范围应该被放置为select范围内的意见。 它是否正确？

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

 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