При чтении таблиц, созданных другими, мы можем столкнуться с проблемой слишком большого числа комментариев. Иногда их так много, что они мешают анализу данных таблиц.

Наверняка вы думали, что хорошо бы вынести все комментарии в отдельную таблицу, к которой можно периодически обращаться за пояснениями. В данной статье мы рассмотрим именно этот способ: вынесем комментарии всех листов книги в отдельную таблицу, сделав ее удобной для работы.

Определим для себя, что бы мы хотели получить от таблицы комментариев:

  • Наименование листа, на котором установлен комментарий
  • Ссылка на ячейку с комментарием – для удобства поиска ячейки или возврата к ней
  • Значение ячейки с комментарием
  • Автор комментария
  • Текст комментария

Для создания такой таблицы комментариев не обойтись без макроса. Универсальный макрос приведен ниже и подробно прокомментирован:

Sub ShowCommentsAllSheets()

    ' Для повышения производительности макроса отключаем перерисовку экрана
    Application.ScreenUpdating = False

    Dim commrange As Range
    Dim mycell As Range
    Dim ws As Worksheet
    Dim newwks As Worksheet
    Dim i As Long

    ' Добавляем новый лист к книге, куда помещаем таблицу комментариев с листов
    Set newwks = Worksheets.Add

    ' Определяем заголовки таблицы примечаний
    newwks.Range("A1:E1").Value = Array("Лист", "Ячейка", "Значение ячейки", "Примечание", "Автор примечания")

    ' Обрабатываем каждый лист в книге
    For Each ws In ActiveWorkbook.Worksheets
        On Error Resume Next
        ' Объектом обработки устанавливаем все ячейки листа, содержащие комментарий
        Set commrange = ws.Cells.SpecialCells(xlCellTypeComments)
        On Error GoTo 0

        If commrange Is Nothing Then
            'Комментариев на листе нет, действий не предпринимаем
        Else
            ' Комментарии на листе присутствуют, продолжаем обработку
            ' Помещаем каждый комментарий в новую сроку таблицы примечаний
            i = newwks.Cells(Rows.Count, 1).End(xlUp).Row

            For Each mycell In commrange
                With newwks
                    i = i + 1
                    On Error Resume Next
                    .Cells(i, 1).Value = ws.Name ' Наименование листа
                    .Cells(i, 2).Hyperlinks.Add Anchor:=.Cells(i, 2), Address:="", SubAddress:= _
"'" + ws.Name + "'" + "!" + mycell.Address, TextToDisplay:=Replace(mycell.Address, "$", "") ' Ссылка на ячейку с комментарием .Cells(i, 3).Value = mycell.Value ' Значение ячейки .Cells(i, 4).Value = mycell.Comment.Text ' Текст комментария .Cells(i, 5).Value = mycell.Comment.Author ' Автор комментария End With Next mycell End If Set commrange = Nothing Next ws ' Отменяем перенос строк в таблице комментариев (для компактности) newwks.Cells.WrapText = False ' Перерисовываем экран после выполнения макроса Application.ScreenUpdating = True End Sub

Выполнение данного макроса создаст таблицу, в которой мы увидим на каком листе книги содержится каждый комментарий, ссылку на ячейку с комментарием, значение ячейки, текст примечания и его автора.

Microsoft Excel - Сводка комментариев

Скачать пример: Excel 2003, Excel 2007+

Добавить комментарий


Защитный код
Обновить

Вверх