如何根据范围将多个单元格值作为注释分配给单元格
How to assign multiple cell values as comment to cell based on Range
我想要运行一个宏,它会根据范围和值从一个sheet分配多个单元格值作为另一个sheet的单元格中的注释。
所以在 Sheet1
中,我想 select 范围 B1:D4
,然后对于每个单元格 if => 0
,添加 Sheet2
中包含的相应注释序列号、操作和数量。
编辑
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
试一试:
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 中没有 "Step 4" 和 "y" 的组合,这就是单元格 C5
中的 4
不显示任何注释的原因。如果已经有评论添加到给定的单元格,代码也会失败(这也可以面向未来)。
编辑:
如果工作表 2 中有多个匹配项:
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
我想要运行一个宏,它会根据范围和值从一个sheet分配多个单元格值作为另一个sheet的单元格中的注释。
所以在 Sheet1
中,我想 select 范围 B1:D4
,然后对于每个单元格 if => 0
,添加 Sheet2
中包含的相应注释序列号、操作和数量。
编辑
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
试一试:
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 中没有 "Step 4" 和 "y" 的组合,这就是单元格 C5
中的 4
不显示任何注释的原因。如果已经有评论添加到给定的单元格,代码也会失败(这也可以面向未来)。
编辑:
如果工作表 2 中有多个匹配项:
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