如何基於范圍為單元格分配多個單元格值作為注釋

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