Перенос заметки в собственный столбец по строке в Excel

У меня есть очень большой файл excel с сотнями заметок на разных ячейках. Я хотел бы извлечь содержимое заметок из каждой строки и поместить их в свой собственный столбец. Например, если бы у меня было 3 заметки в строке 1, текст из этих комментариев был бы помещен в say 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 в настоящее время помещает все заметки в испытательный полигон я уточнил. Не только заметки в их собственном ряду. Я понимаю свою ошибку здесь, внутренняя петля for проходит через весь лист. Я просто не знаю, как решить эту проблему.

EDIT 

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
1 2
excel vba excel-vba

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
2