如何删除excel 2010电子表格中任何列中没有单元格注释的行

我有一个85000行的excel文件，我只需要提取单元格注释，但它目前太大了，所以我想知道我是否可以编写一些VB（以前从未这样做过）或宏或其他东西来遍历每行，查看是否有任何列有单元格注释，如果没有，则删除该行

---

任何关于如何实现这一点的提示都将不胜感激！我有编程背景（很多年前做过一些VB2-6，但从未为Excel编程）

这与您要求的略有不同，但我认为满足您的需要。它选择带有注释的行并将其粘贴，并将第1行中的假定标题粘贴到另一张图纸中。将“表1”更改为适合：

跟进

Option Explicit

Dim RngToCopy As Range

Sub PasteRowsWithComments()
    Dim wsSource As Excel.Worksheet
    Dim wsTarget As Excel.Worksheet
    Dim RowsWithComments As Excel.Range

    Set wsSource = Sheet1: Set wsTarget = Worksheets.Add

    On Error Resume Next
    Set RowsWithComments = wsSource.Cells.SpecialCells(xlCellTypeComments).EntireRow
    On Error GoTo 0

    If Not RowsWithComments Is Nothing Then
        '~~> This is required to clean duplicate ranges so that we do not get
        '~~> the error "That command cannot be used on multiple selections"
        If InStr(1, RowsWithComments.Address, ",") Then _
        Set RngToCopy = cleanRange(RowsWithComments) Else _
        Set RngToCopy = RowsWithComments

        RngToCopy.Copy Destination:=wsTarget.Rows(1)
        wsSource.Range("A1").EntireRow.Copy
        wsTarget.Range("A1").Insert shift:=xlDown
    End If
End Sub

'~~> This function will convert `$1:$1,$1:$1,$4:$4,$7:$7` to `$1:$1,$4:$4,$7:$7`
Function cleanRange(rng As Range) As Range
    Dim col As New Collection
    Dim Myarray() As String, sh As String, tmp As String
    Dim i As Long
    Dim itm As Variant

    sh = rng.Parent.Name: Myarray = Split(rng.Address, ",")

    For i = 0 To UBound(Myarray)
        On Error Resume Next
        col.Add Myarray(i), """" & Myarray(i) & """"
        On Error GoTo 0
    Next i

    For Each itm In col
        tmp = tmp & "," & itm
    Next

    tmp = Mid(tmp, 2): Set cleanRange = Sheets(sh).Range(tmp)
End Function

---

确保工作表处于活动状态，将“12”替换为与

numColumns

相关的列数。在

HasComment（）

中需要一些

On Error

技巧，因为

Comment.Text

错误如果您试图在不存在时检查其值：

Sub RemoveRowsWithoutComments()
Dim rngAll As Range, rng As Range
Dim numColumns As Integer, colCntr As Integer, rowCntr As Long
Dim rowHasComment As Boolean

'set YOUR number of columns
numColumns = 12

Set rngAll = Range("A1", Range("A1").End(xlDown))

rowCntr = rngAll.Count - 1

'need to work backwards because deleting rows messes up forward iteration
Do Until rowCntr = -1

'work with current row (descending)
Set rng = Range("A1").Offset(rowCntr, 0)

rowHasComment = False

    For colCntr = 0 To numColumns

        If HasComment(rng.Offset(0, colCntr)) Then
            rowHasComment = True
            Exit For
        End If

    Next colCntr

    If Not rowHasComment Then rng.Rows.EntireRow.Delete

'decrement
rowCntr = rowCntr - 1
Loop
End Sub

Function HasComment(rng As Range) As Boolean
On Error GoTo NoComment

    If rng.Comment.Text <> "" Then
        HasComment = True
        Exit Function
    End If

NoComment:
    HasComment = False

End Function

Sub-dowswithoutcomments（）
变暗rngAll As范围，rng As范围
Dim NUM列为整数，colCntr为整数，rowCntr为长
Dim rowHasComment作为布尔值
'设置列数
numColumns=12
设置rngAll=范围（“A1”，范围（“A1”）。结束（xlDown））
rowCntr=rngAll.Count-1
'需要向后工作，因为删除行会打乱正向迭代
直到rowCntr=-1为止
'使用当前行（降序）
设置rng=范围（“A1”）。偏移量（行CNTR，0）
rowHasComment=False
对于colCntr=0到numColumns
如果HasComment（rng.Offset（0，colCntr））则
rowHasComment=True
退出
如果结束
下一个colCntr
如果不是rowHasComment，则为rng.Rows.EntireRow.Delete
“减量
rowCntr=rowCntr-1
环
端接头
函数HasComment（rng作为范围）作为布尔值
关于错误转到NoComment
如果rng.Comment.Text为“”，则
HasComment=True
退出功能
如果结束
不注意：
HasComment=False
端函数

这会起作用，但当我尝试运行它时，我在行RowsWithComments.Copy Destination:=wsTarget.Range（“A1”）上得到一个错误，该行表示“该命令不能用于多个选择”+1个编码良好的Doug@BenHolness我无法复制错误，通常情况下，您可以通过在范围的

区域

中循环来解决非连续范围的问题（例如，行中的每个rng1的

区域

等）@BenHolness，我有点期待这种类型的问题，但在我有限的不连续范围测试案例中，它没有弹出，就这样吧。正如brettdj所说，答案在于通过范围循环。+1编码很好。不过，我还是能够复制这个错误。如果在同一行中有两条注释，则会出现错误。Scenatio

$1:$1，$1:$1，$4:$4，$7:$7

是

？行swithcomments.Address

我已经准备好了解决方案。如果你愿意，我可以编辑你的帖子并添加到那里？它与您的解决方案很好地结合在一起。您应该接受我的答案，因为它第一次起作用，包含了多个注释，并且更直接地用更少的代码行获得您问题的答案。：）我只是一个想在StackOF上赢得一些声誉的小家伙！我在你的代码中发现了错误并修复了它，基本上cntr的输入错误（应该是colCntr）应该是0，调用HasComment中的colCntr和HasComment中的“Return”应该是“Exit Function”。谢谢你的反馈。目前正在用我的脚在我的嘴里打字。

Sub RemoveRowsWithoutComments()
Dim rngAll As Range, rng As Range
Dim numColumns As Integer, colCntr As Integer, rowCntr As Long
Dim rowHasComment As Boolean

'set YOUR number of columns
numColumns = 12

Set rngAll = Range("A1", Range("A1").End(xlDown))

rowCntr = rngAll.Count - 1

'need to work backwards because deleting rows messes up forward iteration
Do Until rowCntr = -1

'work with current row (descending)
Set rng = Range("A1").Offset(rowCntr, 0)

rowHasComment = False

    For colCntr = 0 To numColumns

        If HasComment(rng.Offset(0, colCntr)) Then
            rowHasComment = True
            Exit For
        End If

    Next colCntr

    If Not rowHasComment Then rng.Rows.EntireRow.Delete

'decrement
rowCntr = rowCntr - 1
Loop
End Sub

Function HasComment(rng As Range) As Boolean
On Error GoTo NoComment

    If rng.Comment.Text <> "" Then
        HasComment = True
        Exit Function
    End If

NoComment:
    HasComment = False

End Function