Страницы: 1
RSS
Удалить все комментарии из столбца
 
Добрый день.  
Подскажите, пожалуйста , макрос ,который находит все ячейки с комментариями в столбце "C",  
удаляет комментарий из найденной ячейки и добавляет комментарий в соседней справа ячейке.  
Спасибо.
 
Удалить примечания из столбца C  - не проблема. А вот какая закономерность используется, чтобы ВСТАВИТЬ примечания в столбце D - не понял. Какие условия должны быть соблюдены для вставки примечания в конкретную ячейку столбца D?
Кому решение нужно - тот пример и рисует.
 
Sub Удалить_Комменты()  
 
Columns("C:C").Select  
Selection.ClearComments  
 
End Sub
With my best regards,      Inter_E
 
Вот один мой пример, который сам когда-то использавал, адаптируйте  
Просто можно тексты для комментов в отдельном столбце где-то написать, а код возьмет эти тексты в комменты  
 
 
Sub EComments()  
   Dim ESpace As Range  
'Application.ScreenUpdating = False  
   With ActiveSheet  
   Application.Goto Reference:="ESpace"  
       Set ESpace = Selection  
Selection.ClearComments  
'        ESpace.Activate  
       For x = 1 To ESpace.Rows.Count  
           For y = 1 To ESpace.Columns.Count  
                For n = 18 To 80  
                       
                    If ESpace(x, y) = Cells(n, 42) And ESpace(x, y) > 0 Then  
                         
'                                                ESpace(x, y).Select  
                                               ESpace(x, y).AddComment  
                                                 
                                               ESpace(x, y).Comment.Text Text:=Chr(11) & "  " & Cells(n, 43) & "              " & Cells(n, 44) & "    ТТ.:" & Cells(x + 17, 47) & "    Тел. ТТ.: " & Cells(x + 17, 48)  
                             
                                               With ESpace(x, y).Comment.Shape.TextFrame.Characters.Font  
                                                   .ColorIndex = 0  
                                                   .Size = 16 '8 '20  
                                                   .Name = "Tahoma"  
                                                   .Bold = True  
                                               End With  
                                                With ESpace(x, y).Comment.Shape  
                                                   .Width = 250 '100  
                                                   .Height = 160 '70  
                                               End With  
                                                 
                                              ESpace(x, y).Comment.Visible = False  
                             
                     Exit For  
                 End If  
               Next n  
           Next y  
       Next x  
   End With  
'Application.ScreenUpdating = True  
End Sub
With my best regards,      Inter_E
 
{quote}{login=Пытливый}{date=28.09.2010 08:55}{thema=}{post}Удалить примечания из столбца C  - не проблема. А вот какая закономерность используется, чтобы ВСТАВИТЬ примечания в столбце D - не понял. Какие условия должны быть соблюдены для вставки примечания в конкретную ячейку столбца D?{/post}{/quote}  
 
Закономерность такая. Если в ячейке столбца "C" встречается примечание,  
то примечание из этой ячейки удаляем и вставляем примечание с другим текстом в  
соседнюю ячейку в столбце "D".
 
{quote}{login=Егор}{date=28.09.2010 09:04}{thema=Re: }{post}{quote}{login=Пытливый}{date=28.09.2010 08:55}{thema=}{post}Удалить примечания из столбца C  - не проблема. А вот какая закономерность используется, чтобы ВСТАВИТЬ примечания в столбце D - не понял. Какие условия должны быть соблюдены для вставки примечания в конкретную ячейку столбца D?{/post}{/quote}  
 
Закономерность такая. Если в ячейке столбца "C" встречается примечание,  
то примечание из этой ячейки удаляем и вставляем примечание с другим текстом в  
соседнюю ячейку в столбце "D".{/post}{/quote}  
Доп.вопросы:  
1. "Вставляем примечание с другим текстом в соседнюю ячейку в столбце D" - с каким текстом? Пользователь должен ввести?  
2. Что делать, если примечания есть и в ячейке столбца С, и в ячейке столбца D в одной строке? Заменять? Не трогать?
 
{quote}{login=}{date=28.09.2010 09:35}{thema=Re: Re: }{post}{quote}{login=Егор}{date=28.09.2010 09:04}{thema=Re: }{post}{quote}{login=Пытливый}{date=28.09.2010 08:55}{thema=}{post}Удалить примечания из столбца C  - не проблема. А вот какая закономерность используется, чтобы ВСТАВИТЬ примечания в столбце D - не понял. Какие условия должны быть соблюдены для вставки примечания в конкретную ячейку столбца D?{/post}{/quote}  
 
Закономерность такая. Если в ячейке столбца "C" встречается примечание,  
то примечание из этой ячейки удаляем и вставляем примечание с другим текстом в  
соседнюю ячейку в столбце "D".{/post}{/quote}  
Доп.вопросы:  
1. "Вставляем примечание с другим текстом в соседнюю ячейку в столбце D" - с каким текстом? Пользователь должен ввести?  
2. Что делать, если примечания есть и в ячейке столбца С, и в ячейке столбца D в одной строке? Заменять? Не трогать?{/post}{/quote}  
 
1. Текст примечания в столбце "D" - дата создания примечания.  
2. Если в соседней ячейке в столбце "D" уже есть примечание, то только удаляем примечание из ячейки столбца "C", а соседнюю ячейку столбца "D" не трогаем.
 
Наверное, как-то так:  
Sub MoveComments()  
 
Dim lngI As Long  
   For lngI = 1 To Worksheets("Как есть").Cells(Rows.Count, 2).End(xlUp).Row  
       If Not Worksheets("Как есть").Range("C" & lngI).Comment Is Nothing _  
       And Worksheets("Как есть").Range("D" & lngI).Comment Is Nothing Then  
           Worksheets("Как есть").Range("D" & lngI).AddComment Text:=Format(Now(), "dd.mm.yyyy")  
           Worksheets("Как есть").Range("C" & lngI).Comment.Delete  
       End If  
   Next lngI  
End Sub
Кому решение нужно - тот пример и рисует.
 
Точнее, вот так (забыл про удаление коммента, если есть и в С и в Д)  
Sub MoveComments()  
Dim lngI As Long  
   For lngI = 1 To Worksheets("Êàê åñòü").Cells(Rows.Count, 2).End(xlUp).Row  
       If Not Worksheets("Êàê åñòü").Range("C" & lngI).Comment Is Nothing _  
       And Worksheets("Êàê åñòü").Range("D" & lngI).Comment Is Nothing Then  
           Worksheets("Êàê åñòü").Range("D" & lngI).AddComment Text:=Format(Now(), "dd.mm.yyyy")  
           Worksheets("Êàê åñòü").Range("C" & lngI).Comment.Delete  
       ElseIf Not Worksheets("Êàê åñòü").Range("C" & lngI).Comment Is Nothing Then  
           Worksheets("Êàê åñòü").Range("C" & lngI).Comment.Delete  
       End If  
   Next lngI  
End Sub
Кому решение нужно - тот пример и рисует.
 
Извините, коряво скопировалось. Модераторы, будьте добры, удалите мой прошлый пост.  
 
Sub MoveComments()  
Dim lngI As Long  
   For lngI = 1 To Worksheets("Как есть").Cells(Rows.Count, 2).End(xlUp).Row  
       If Not Worksheets("Как есть").Range("C" & lngI).Comment Is Nothing _  
       And Worksheets("Как есть").Range("D" & lngI).Comment Is Nothing Then  
           Worksheets("Как есть").Range("D" & lngI).AddComment Text:=Format(Now(), "dd.mm.yyyy")  
           Worksheets("Как есть").Range("C" & lngI).Comment.Delete  
       ElseIf Not Worksheets("Как есть").Range("C" & lngI).Comment Is Nothing Then  
           Worksheets("Как есть").Range("C" & lngI).Comment.Delete  
       End If  
   Next lngI  
End Sub
Кому решение нужно - тот пример и рисует.
 
Спсибо большое за решение. Отлично подходит.
Страницы: 1
Читают тему
Наверх