Есть таблица по платежам. В ячейках определенных столбцов в примечаниях(вкладка Рецензирование -Создать примечание) записывается дополнительная информация по платежу. Например, номер договора, на основании которого был произведен платеж. И теперь необходимо отобрать записи только по определенным договорам. Ячеек несколько сотен, просматривать и выписывать договора из комментариев вручную похоже на одну из разновидностей древнеримских пыток. Однако при помощи VBA сделать это совсем просто.

Создадим простую функцию пользователя:

Function Get_Text_from_Comment(rCell As Range)
    On Error Resume Next
    Get_Text_from_Comment = rCell.Comment.Text
End Function

Синтаксис вызова функции с листа Excel:
=Get_Text_from_Comment(A1)
A1 - ячейка с примечанием, текст которого необходимо получить. Если комментарий в ячейке отсутствует, то функция вернет пусто.
Чтобы правильно использовать приведенный код, необходимо сначала ознакомиться со статьей Что такое функция пользователя(UDF)?. Вкратце: необходимо скопировать текст кода выше, перейти в редактор VBA(Alt+F11) -создать стандартный модуль(Insert -Module) и в него вставить скопированный текст. После чего функцию можно будет вызвать из Диспетчера функций, отыскав её в категории Определенные пользователем (User Defined Functions).


Текст из примечания без автора примечания
Слегка доработанная функция, в которой можно отсечь имя пользователя, создавшего комментарий:

Function Get_Text_from_Comment(rCell As Range) As String
    Dim sTxt As String
    On Error Resume Next
    sTxt = rCell.Comment.Text
    Get_Text_from_Comment = Mid(sTxt, InStr(sTxt, ":") + 2)
End Function

Синтаксис вызова с листа Excel такой же, как и в функции выше. Просто указываете внутри функции ссылку на ячейку.
=Get_Text_from_Comment(A1)


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

'---------------------------------------------------------------------------------------
' Author : The_Prist(Щербаков Дмитрий)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          http://www.excel-vba.ru
' Purpose: Процедура записи текста из примечаний в ячейки выделенного диапазона
'---------------------------------------------------------------------------------------
Sub CommentsToCell()
    Dim sTxt As String, res As String, rc As Range, rr As Range
    Dim IsDelAuthor As Boolean, IsDelComment As Boolean, IsReplaceCellVal As Boolean
    'запрашиваем параметры
    If MsgBox("Оставлять автора комментария?", vbQuestion + vbYesNo, "www.excel-vba.ru") = vbNo Then
        IsDelAuthor = True
    End If
    If MsgBox("Заменять значение, если в ячейке с комментариями уже есть текст?" & vbNewLine & _
              "ДА(Yes) - значения ячеек будут заменены текстом комментариев" & vbNewLine & _
              "НЕТ(No) - к имеющимся значениям будет добавлен текст комментария", vbQuestion + vbYesNo, "www.excel-vba.ru") = vbYes Then
        IsReplaceCellVal = True
    End If
    If MsgBox("Удалять комментарии после обработки?", vbQuestion + vbYesNo, "www.excel-vba.ru") = vbYes Then
        IsDelComment = True
    End If
    On Error Resume Next
    'получаем в выделенном диапазоне только ячейки с комментариями
    Set rr = Selection.SpecialCells(xlCellTypeComments)
    If rr Is Nothing Then
        MsgBox "В выделенном диапазоне нет ячеек с комментариями", vbCritical, "www.excel-vba.ru"
        Exit Sub
    End If
    On Error GoTo 0
    Application.ScreenUpdating = False
    'цикл по всем ячейкам с комментариями
    For Each rc In rr.Cells
        sTxt = rc.Comment.Text
        If IsDelAuthor Then
            res = Mid(sTxt, InStr(sTxt, ":") + 2)
        Else
            res = sTxt
        End If
        If IsReplaceCellVal Then
            rc.Value = res
        Else
            rc.Value = rc.Value & Chr(10) & res
        End If
    Next
    If IsDelComment Then
        rr.ClearComments
    End If
    Application.ScreenUpdating = True
    MsgBox "Комментарии записаны", vbCritical, "www.excel-vba.ru"
End Sub

Код необходимо так же скопировать и вставить в стандартный модуль(Переходим в редактор VBA(Alt+F11) -Insert -Module).
Выделить диапазон ячеек, комментарии из которых необходимо перенести, нажать Alt+F8 и выбрать код CommentsToCell. Код содержит несколько параметров:

  • Сначала необходимо будет выбрать оставить ли автора комментария при считывании текста из комментария. Если выбрать да - весь текст примечания будет перенесен как есть. Если выбрать Нет - то из комментария будет отсечена первая строка до символа двоеточия(:). Именно так по умолчанию Excel обозначает автора.
    Этот параметр нужен, если в ячейках нет автора.
  • Далее будет запрос: оставить значение в ячейках и дописать к ним текст примечания или заменить существующие значения в ячейке на текст комментария. Может пригодиться, если в ячейках записаны суммы платежей и надо добавить к ним из комментария номер договора, не убирая сами суммы.
  • И последний запрос будет: удалять комментарии из ячеек после записи текста из них в ячейки или оставить. Если выбрать да - то после обработки всех выделенных ячеек комментарии будут удалены. Это может пригодиться, если комментариев много. Их удаление может существенно облегчить файл.

Также см.:
Что такое функция пользователя(UDF)?
Как скопировать картинку из примечания?
Создание примечаний

Loading

6 комментариев

  1. в последний пример надо добавить строку что бы в ячейках овновления было при обновлении примечания. а так приходится заново функцию запускать

  2. Если код написать вот так:
    .....
    Dim sTxt As String
    Application.Volatile True
    On Error Resume Next
    ....
    то функция будет пересчитываться по нажатию F9.
    Мысль не моя - украл у Павла с планеты))

  3. Кто нибудь может выложить полное описание. Начиная с ноля, то есть с документа с кучей ячеек с примечаниями. Я новичёк в этом деле а задача попалась именно такая. Заранее благодарен.

  4. Подскажите пожалуйста, можно ли модифицировать макрос так, что бы если нет примечаний вообще, то что бы макрос не прекращал работу, а вписывал к примеру в ячейку А1 слово "Груша", точнее я имею в виду, что бы он просто делал то, что ему положено делать дальше....

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

Этот сайт использует Akismet для борьбы со спамом. Узнайте, как обрабатываются ваши данные комментариев.