vba 根据另一个单元格范围的值创建对一系列单元格的注释

Create comments to a range of cells ftom the values of another range of cells

提问by Philip Gruber

I want to create comments to a range of cells. The comments should contain the values of another range of cells.

我想为一系列单元格创建注释。注释应包含另一个单元格范围的值。

Here is what I have so far:

这是我到目前为止所拥有的：

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

This works for one cell. I need this for a range of cells. For example, let's say I need the values of cells A1:F20 in comments of cells A21:F40. I do not want to copy the same Sub as many times.

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

采纳答案by Amen Jlili

It should do you the job if you replace

如果你更换它应该可以完成你的工作

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

This will basically ignore all empty cells.

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

Output:

输出：

My code:

我的代码：

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

回答by Philip Gruber

I made some adaptions to your advices, thanks a lot, this solved my problem:

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

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

回答by PommesKlaus

From your question I understand that you want to select a range of cells (e.g. "A1:A5"), then select another range of cells (e.g. "B6:B10") and the respective values of the first selected Range should be placed as comments in the secon selected Range. Is this correct?

从您的问题我了解到您要选择一系列单元格（例如“A1：A5”），然后选择另一个单元格范围（例如“B6：B10”），并且第一个选定范围的相应值应放置为在第二个选定范围中的评论。这样对吗？

The following code checks if 2 ranges with an equal length are selected and copies the values of the first selected range as comments to the second selected range:

以下代码检查是否选择了 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