如何基于范围为单元格分配多个单元格值作为注释

Question

我想运行一个宏，该宏将根据范围和值从一个工作表分配多个单元格值作为另一工作表的单元格中的注释。

因此，在Sheet1 ，我想选择范围B1:D4 ，然后对于每个单元格， if => 0 ，则从Sheet2中添加相应的注释，其中包含序列号，操作和数量。

编辑

编辑2

Sub COMMENTS()
'
' COMMENTS Macro
    Dim rngCell As Range
    Dim strComment, strStep, strObject As String, strConcat As String
    Dim varMatch As Variant
    Dim arrConcat() As String

    For Each rngCell In Sheet2.Range("E2:E30")
        strConcat = strConcat & rngCell & rngCell.Offset(0, -4) & "||"
    Next rngCell

    arrConcat = Split(strConcat, "||")

    For Each rngCell In Sheet1.Range("B2:D5")
        If rngCell > 0 Then
            strStep = Right(Sheet1.Cells(rngCell.Row, 1).Value, 1)
            strObject = Sheet1.Cells(1, rngCell.Column).Value
            varMatch = Application.Match(strStep & strObject, arrConcat, 0)
            If Not IsError(varMatch) Then
                With Sheet2
                    strComment = "Serial number: " & .Range("B" & varMatch + 1).Value & Chr(10) _
                        & "Operation: " & .Range("C" & varMatch + 1).Value & Chr(10) _
                        & "Quantity: " & .Range("D" & varMatch + 1).Value
                End With
                rngCell.AddComment (strComment)
            End If
        End If
    Next rngCell
End Sub

Answer 1

试试看：

Sub COMMENTS()
    Dim rngCell As Range
    Dim strComment, strStep, strObject As String, strConcat As String
    Dim varMatch As Variant
    Dim arrConcat() As String

    For Each rngCell In Sheet2.Range("E2:E9")
        strConcat = strConcat & rngCell & rngCell.Offset(0, -4) & "||"
    Next rngCell

    arrConcat = Split(strConcat, "||")

    For Each rngCell In Sheet1.Range("B2:D5")
        If rngCell > 0 Then
            strStep = Right(Sheet1.Cells(rngCell.Row, 1).Value, 1)
            strObject = Sheet1.Cells(1, rngCell.Column).Value
            varMatch = Application.Match(strStep & strObject, arrConcat, 0)
            If Not IsError(varMatch) Then
                With Sheet2
                    strComment = "Serial number: " & .Range("B" & varMatch + 1).Value & Chr(10) _
                        & "Operation: " & .Range("C" & varMatch + 1).Value & Chr(10) _
                        & "Quantity: " & .Range("D" & varMatch + 1).Value
                End With
                rngCell.AddComment (strComment)
            End If
        End If
    Next rngCell
End Sub

结果：

请注意，Sheet2中不存在“步骤4”和“ y”的组合，这就是为什么单元格C5中的4不显示任何注释的原因。 如果已经在给定的单元格中添加了注释，则代码也将失败（这也可以用于将来）。

编辑：

如果Sheet2中有多个匹配项：

Sub COMMENTS()
    Dim rngCell As Range
    Dim strComment As String, strStep As String, strObject As String, strConcat As String
    Dim arrConcat() As String
    Dim lngPos As Long

    For Each rngCell In Sheet2.Range("E2:E13")
        strConcat = strConcat & rngCell & rngCell.Offset(0, -4) & "||"
    Next rngCell

    arrConcat = Split(strConcat, "||")

    For Each rngCell In Sheet1.Range("B2:D5")
        If rngCell.Value >= 0 Then
            strStep = Right(Sheet1.Cells(rngCell.Row, 1).Value, 1)
            strObject = Sheet1.Cells(1, rngCell.Column).Value
            For lngPos = 0 To UBound(arrConcat)
                If LCase$(strStep & strObject) = LCase$(arrConcat(lngPos)) Then
                    With Sheet2
                        strComment = strComment & Chr(10) _
                            & "Serial number: " & .Range("B" & lngPos + 2).Value & Chr(10) _
                            & "Operation: " & .Range("C" & lngPos + 2).Value & Chr(10) _
                            & "Quantity: " & .Range("D" & lngPos + 2).Value
                    End With
                End If
            Next lngPos
            rngCell.ClearComments
            If Len(strComment) Then
                rngCell.AddComment (Right(strComment, Len(strComment) - 1))
                rngCell.Comment.Shape.TextFrame.AutoSize = True
            End If
            strComment = vbNullString
        End If
    Next rngCell
End Sub