|
|||||||
Как получить текст примечания в ячейку?
Время создания: 16.03.2019 23:43
Текстовые метки: примечания
Раздел: Разные закладки - VBA - Excel
Запись: xintrea/mytetra_db_adgaver_new/master/base/1514992275wo1dnrs6ek/text.html на raw.githubusercontent.com
|
|||||||
|
|||||||
Как получить текст примечания в ячейку? Есть таблица по платежам. В ячейках определенных столбцов в примечаниях(вкладка Рецензирование -Создать примечание) записывается дополнительная информация по платежу. Например, номер договора, на основании которого был произведен платеж. И теперь необходимо отобрать записи только по определенным договорам. Ячеек несколько сотен, просматривать и выписывать договора из комментариев вручную похоже на одну из разновидностей древнеримских пыток. Однако при помощи VBA сделать это совсем просто. Создадим простую функцию пользователя : Function Get_Text_from_Comment(rCell As Range) On Error Resume Next Get_Text_from_Comment = rCell.Comment.Text End Function
Синтаксис вызова функции с листа Excel: Текст из примечания без автора примечания 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 такой же, как и в функции выше. Просто указываете внутри функции ссылку на ячейку. Код записи текста примечаний в выделенных ячейках '--------------------------------------------------------------------------------------- ' 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
|
|||||||
Так же в этом разделе:
|
|||||||
|
|||||||
|