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

Question

I want to run a macro that will assign multiple cell values from one sheet as a comment in cells on another sheet, based on range and value.

So in Sheet1 , I want to select range B1:D4 , then for each cell, if => 0 , add the corresponding comment from Sheet2 containing serial number, operation, and quantity.

edit

EDIT2

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

Give it a try:

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

Result:

Note that there is no combination of "Step 4" and "y" present in Sheet2, that is why 4 in cell C5 does not show any comment. The code will also fail if there is already a comment added to a given cell (this can be also future-proofed).

Edit:

In case there is more than one match in 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