如何在Excel中为注释的特定行(条件是存在的)着色？

Question

亲爱的Excel和VBA专家！你能告诉我如何在评论中给某一行(条件--某个词的存在)涂上颜色吗？注释由几行组成，用Chr (10)分隔。Picture1中的示例:注释有4行，第二行包含单词"VBA"，因此这一行应该用红色高亮显示。主要问题是测试词"VBA“可以出现在任何行，可以从1行到10+行。我以为：

1. 可以将数据从注释移动到单元格。
2. 将Chr (10)替换为某些字符，例如"_“
3. 通过“列分发向导”将单元格的文本分发到列中。
4. 在接收到的单元格中搜索所需的单词"VBA“
5. 确定单元格号，并理解这是注释中所需的行号。
6. 根据单元格号，在注释中绘制行号。

你能告诉我我的行动逻辑是否正确吗？我朝正确的方向走了吗？如果是的话，执行第4-6点的正确方法是什么？

在这里输入图像描述

Answer 1

这个有用吗？

“测试”是我设置的纸张的代号，根据你的情况修改。

"i“将给出行号，从0开始。所以在你的例子中，它是1。

编辑：在if检查中添加了Exit For。

Option Explicit

Sub test_note()

    Dim strNote As String
    Dim arrNote As Variant
    Dim number_of_lines As Integer
    
    strNote = test.Range("A5").NoteText
    number_of_lines = Len(strNote) - Len(Replace(strNote, Chr(10), "")) + 1
    
    ReDim arrNote(1 To number_of_lines) As String
    
    arrNote = Split(strNote, Chr(10))
    
    Dim i As Long
    
    For i = LBound(arrNote) To UBound(arrNote)
        
        If InStr(arrNote(i), "VBA") > 0 Then
            Debug.Print i, arrNote(i)
            Exit For 'If you are sure there won't be any other occurrence of VBA in there, why check the rest of the lines? Speeds code depending on circumstance.
        End If
        
    Next i
    
End Sub

编辑2：修改代码以更改注释行的颜色。

Sub test_note()

    Dim strNote As String
    Dim arrNote As Variant
    Dim number_of_lines As Integer
    
    strNote = test.Range("B5").NoteText
    number_of_lines = Len(strNote) - Len(Replace(strNote, Chr(10), "")) + 1
    
    ReDim arrNote(1 To number_of_lines) As String
    
    arrNote = Split(strNote, Chr(10))
    
    Dim i As Long
    Dim startPos As Integer
    Dim number_of_chars As Integer
    
    startPos = 1
    
    ' Reset comment font color
    test.Range("B5").Comment.Shape.TextFrame.Characters.Font.Color = 0
    
    For i = LBound(arrNote) To UBound(arrNote)
        
        If InStr(arrNote(i), "VBA") > 0 Then
            number_of_chars = Len(arrNote(i))
            test.Range("B5").Comment.Shape.TextFrame.Characters(startPos, number_of_chars).Font.Color = vbRed
            Debug.Print i, arrNote(i), "startPos: " & startPos, "numChars: " & number_of_chars
        Else
            startPos = startPos + Len(arrNote(i)) + 1
        End If
        
    Next i
    
End Sub

Answer 2

看看这个。只要运行此VBA，就可以将您的注释复制到单元格中，并突出显示包含"VBA“的行，但是，它对所有工作表上的所有注释都是这样做的。

信贷：https://martinbosanacvba.blogspot.com/2021/08/copying-comments-to-cells-and.html

Sub Demo()
    
    Dim tnahqb1 As Range
    Dim tnahqb2 As Range
    Dim tnahqb3 As Workbook
    Dim tnahqb4 As Worksheet
    Dim tnahqb5 As Variant
    Dim tnahqb6 As Integer
    Dim tnahqb7 As Integer
    Dim tnahqb8 As Integer
    Dim tnahqb9 As Integer
        
    For Each tnahqb10 In ActiveWorkbook.Worksheets
        Set tnahqb1 = tnahqb10.Cells.SpecialCells(xlCellTypeComments)

        If tnahqb1 Is Nothing Then
            MsgBox "No comments in the sheet"
        Else
            For Each cell In tnahqb1
                cell.Value = cell.Comment.Text
                tnahqb5 = Split(cell.Comment.Text, Chr(10))
                tnahqb6 = UBound(tnahqb5) - LBound(tnahqb5) + 1

                For I = LBound(tnahqb5) To UBound(tnahqb5)
                    
                    If InStr(tnahqb5(I), "VBA") > 0 Then
                        tnahqb8 = Len(tnahqb5(I))
                        
                        With cell
                            tnahqb7 = InStr(cell.Comment.Text, tnahqb5(I))
                            tnahqb9 = tnahqb7 + tnahqb8
                            .Characters(tnahqb7, tnahqb8).Font.Color = vbRed
                        End With

                    End If

                Next I

            Next cell

        End If

    Next tnahqb10

End Sub