将注释转移到Excel中逐行

我有一个非常大的Excel文件，在不同的单元格上有数百个笔记。 我想提取每一行的注释内容，并把它们放在自己的列中。 例如，如果我在第1行中有3个笔记，那么这些注释中的文本将被放入U1中。 如果有4条评论在第2排，那么这4条评论将在U2中，所以也是如此。 我使用VBA做到这一点，但无法让他们逐行分开。

Sub CopyCommentsToCol() Dim i As Integer i = 2 Dim Rng As Range Dim cell As Range Dim row As Range Dim commrange As Range Dim curwks As Worksheet Set Rng = Range("A2:A5") 'Test Range for now Set curwks = ActiveSheet On Error Resume Next Set commrange = curwks.Cells _ .SpecialCells(xlCellTypeComments) On Error GoTo 0 On Error Resume Next If Err.Number <> 0 Then Err.Clear End If For Each row In Rng.Rows For Each cell In commrange 'Application.ActiveCell.Comment If cell.Comment <> Empty Then Range("$U$" & i) = Range("$U$" & i).Text & cell.Comment.Text End If Next cell i = i + 1 Next row End Sub 

这个vba代码现在把所有的笔记放在我指定的testing范围内。 不只是他们自己的笔记。 我明白我的错误在这里，内循环是贯穿整个表格。 我只是不知道如何解决这个问题。

编辑

 For Each row In Rng.Rows Set commrange = row.SpecialCells(xlCellTypeComments) For Each cell In commrange If cell.Comment <> Empty Then Range("$U$" & i) = Range("$U$" & i).Text & cell.Comment.Text End If Next cell i = i + 1 Next row 

Answer 1

你可以使用Rows集合。 就像是

 For Each row In yourRange.Rows 'collect comments Next row 

更新：

由于第一个想法不起作用，您可以检查cell.Row并在单元格中添加文本时使用它。

 Sub CopyCommentsToCol() Dim Rng As Range Dim cell As Range Dim row As Range Dim commrange As Range Dim curwks As Worksheet Set Rng = Range("A2:A5") 'Test Range for now Set curwks = ActiveSheet On Error Resume Next Set commrange = curwks.Cells _ .SpecialCells(xlCellTypeComments) On Error GoTo 0 On Error Resume Next If Err.Number <> 0 Then Err.Clear End If For Each cell In commrange 'Application.ActiveCell.Comment If cell.Comment <> Empty Then Range("$U$" & cell.Row) = Range("$U$" & cell.Row).Text & cell.Comment.Text End If Next cell End Sub