Question

我在指定Excel单元格注释中包含的特定信息时遇到问题。我在多个工作簿中有多个注释，总计超过1M，因此我正在寻找一种方法，我可以应用例程来清理工作簿，然后将其合并到Workbook_Open（）中以供所有工作簿使用。

示例注释 - 在第一行文本之前，任意两行文本之间或最后一行文本之后可能有一行空行或二十行。

**









May 8






June 1






**

我有一个小程序可以解决问题。

Sub RemoveBlankCommentRows()
Dim c As Comment

For Each c In ActiveSheet.Comments
    c.Text Replace(c.Text, "" & Chr(10), " ")
    rng.Comment.Shape.TextFrame.AutoSize = True
Next c

End Sub

唯一的问题是它将所有评论数据放在一行中，如下所示。

**May 8  June 1**

我想要的是它返回如下所示，在文本之间有或没有空行：

**May 8

June 1**

我正在寻找的方法是区分Comment中有文本的行和没有可见文本的行，但可能有空格或几个空格，vbNull，vbNullChar，vbNullString或任何其他不可打印的信息。我面临的问题是要了解如何确定评论的哪一行，或者是评论作为一个整体？

对此的任何帮助都将非常感激。我在任何地方都进行了搜索，没有任何方法可以解决问题，而不会将所有文本放在一行中。

Answer 1

一种非常基本的方法，但试试这个：

Sub RemoveBlankCommentRows()
Dim c As Comment

For Each c In ActiveSheet.Comments
    If Len(c.Text) < 2 Then c.Text Replace(c.Text, "" & Chr(10), " ")
    rng.Comment.Shape.TextFrame.AutoSize = True
Next c

编辑：

需要对其进行修改以在注释中使用。由于特定于我的用例的原因，它被分成3个，但是对于宏观用途（如在大区域中使用它），我刚刚在工具栏上创建了一个按钮cleanSpecialsFromSelection。

对于这个数据集，我处理导入的数据，由于我只能假设的原因，字符编码问题包含许多不可打印的字符，结果对我来说是完美的。但它并不优雅 - 它依赖于最基本的暴力方法，对于大型数据集，它需要时间来完成。在我的工作站上，8x3000的选择将花费近10秒。

这是我的代码：

Global bannedChars As String

Sub cleanSpecialCharacters(Optional str As Range)
bannedChars = Chr(127) & "," & Chr(129) & "," & Chr(141) & "," & Chr(143) & "," & Chr(144) & "," & Chr(157) & "," & Chr(160)
Application.ScreenUpdating = False

If IsMissing(str) Then Set str = Range(Selection.Item(1).Address)

Dim tVal As String, bChar As Variant
tVal = str.Value

tVal = Application.WorksheetFunction.Clean(tVal)
tVal = Application.WorksheetFunction.Trim(tVal)

For Each bChar In Split(bannedChars, ",")
    tVal = Replace(tVal, bChar, "")
Next

If IsNumeric(tVal) Then
    str.Value = CLng(tVal)
Else
    str.Value = tVal
End If

Application.ScreenUpdating = True
End Sub


Sub cleanSpecialCharactersRange(str As Range)
    ' Argument passed to this sub should be >1 cell, otherwise call cleanSpecialCharacters() directly
    Dim c As Range
    For Each c In str.Cells
        Call cleanSpecialCharacters(c)
    Next
End Sub


Sub cleanSpecialsFromSelection()
    Dim rng As Range
    Set rng = Selection
    Call cleanSpecialCharactersRange(rng)
End Sub

Answer 2

解决了！我终于通过使用Split函数找到了解决方案。它从我的标准代码开始，以加快速度并防止不需要的错误消息。这是一种真正的暴力方法，我相信有更有说服力的方法来做到这一点。但是，这解决了我在使用不可打印的字符，空格等问题时遇到的所有问题。我现在得到行中保留的每一行信息，在数据行之前，之后或中间都没有大部分空白行。

接近结尾时，我添加了一些代码，使评论看起来更好。浅黄色变得非常古老，非常快。希望将来其他人可以使用它。

    Sub SplitCellComment()
    '   Using the vba Split function: return each substring, and its 
    '   length, on splitting a string; _
    '    number of occurrences of a character 
    '   (ie. delimiter) within a string;

        Dim Cmt As Excel.Comment
        Dim i As Integer
        Dim LArea As Long, xCmt As Long
        Dim sText As String, sChr As String
        Dim arr As Variant, varExp As Variant, varDelim As Variant

    '   Turn the following activity off to increase program speed.
        With Application
            .StatusBar = True
            .EnableEvents = False
            .DisplayAlerts = False
            .ScreenUpdating = False
        End With

        For Each Cmt In ActiveSheet.Comments
            sText = ""

    '       specify string expression which will be split into substrings:
            varExp = Cmt.Text

    '       specify delimiter for substrings:
            varDelim = Chr(10) '"s"

            arr = Split(varExp, varDelim)
    '       includes an array element representing a sub-string of zero- 
    '       length before the first character which is the delimiter.

            For i = LBound(arr) To UBound(arr)
    '       return each element of the array - these are the substrings into
    '       which the string expression is split into.

    '           Remove any spaces that may be present on blank rows.
                arr(i) = Trim(arr(i))

    '           If the left character of the first row = Chr(10) 
    '           then delete it.
                If Left(arr(0), 1) = Chr(10) Then Left(arr(0), 1) = ""

    '           If a row as a length of 0 then trim any spaces from the 
    '           ends. Otherwise add a Chr(10) after the text.
                If Len(arr(i)) = 0 Then
                    arr(i) = ""
                    sText = Trim(sText) & arr(i)
                Else
                    sText = Trim(sText) & Chr(10) & arr(i)
                End If

    '           Due to Chr(10) being inserted automatically at the 
    '           beginning of the text, this will remove the first character.
                If i = 0 Then
                    If Len(sText) <> Len(arr(0)) Then
                        sText = Mid(sText, 2, Len(sText))
                    End If
                End If

    '           In some cases the next If...Then is required to remove 
    '           non-printable characters.
                On Error Resume Next
                If Asc(Left(sText, 1)) < 32 Then sText = Mid(sText, 2, Len(sText))
                On Error GoTo 0
            Next i
            Cmt.Text sText

    '       Format comment shape, size and font.
            With Cmt
    '           Beveled button
                .Shape.AutoShapeType = msoShapeActionButtonCustom    
                .Shape.TextFrame.Characters.Font.Name = "Tahoma"
                .Shape.TextFrame.Characters.Font.Size = 10
                .Shape.TextFrame.Characters.Font.ColorIndex = 2
                .Shape.Line.ForeColor.RGB = RGB(0, 0, 0)
                .Shape.Line.BackColor.RGB = RGB(255, 255, 255)
                .Shape.Fill.Visible = msoTrue
                .Shape.Fill.ForeColor.RGB = RGB(58, 82, 184)
                .Shape.Fill.OneColorGradient msoGradientDiagonalUp, 1, 0.23
            End With
        Next Cmt

    '   Return the following activity on for future use.
        With Application
            .StatusBar = False
            .EnableEvents = True
            .DisplayAlerts = True
            .ScreenUpdating = True
        End With
    End Sub

使用VBA删除Excel注释中的空行

2 个答案: