Как изменить макрос добавления примечания?

[AllenJ]

Добрый вечер. Есть макрос:

Dim i&
On Error Resume Next
For i = 10 To 15
If Cells(i, 3) = 20 Then
Cells(i, 4) = Cells(i, 4) + 1
If Cells(i, 4).Comment Is Nothing Then
With Cells(i, 4).AddComment
.Visible = False
.Text Cells(7, 2).Value & Chr(10)
Cells(i, 4).Comment.Shape.TextFrame.Characters.Font.Bold = True
End With
Else
Cells(i, 4).Comment.Text Cells(i, 4).Comment.Text & Cells(7, 2).Value & Chr(10)
End If
End If
Next
End Sub

Он делает следующее: берет значение 20 (если есть) из ячеек Cells(i, 3) и втавляет примечание в ячейки Cells(i, 4). При этом, если в ячейке уже есть значение - новое добавляется под предыдущим. В примере все более понятно и наглядно. Понажимайте кнопку и поймете принцип действия.

Что интересует: как видоизменить макрос так, как на листе 2 примера?

То есть, нужно чтобы любое число, которое стоит в ячейке С10 всталвяло в примечание в той же ячейке в виде:
21.12.2012 - 20
(если в С10 стоит цифра 20), если стоит цифра 0 - 21.12.2012 - 0 и т. д.)

Спасибо!

[staniiislav]

возможно так вы хотели
пробуйте

[AllenJ]

Пока еще не все протестировал, но вроде все так, как надо. Спасибо!
Только одно но, если в ячейке стоит цифра, например 5 - добавляется примечание как надо, но если снова нажать кнопку - примечание не добавляется. Добавляется примечание только если цифра изменится. Можно это изменить? Чтобы сколько раз кнопку нажал - столько раз и добавилось примечание, независимо от того, изменилась цифра или нет. Спасибо.

[staniiislav]

Переделал, но там стояла проверка не только на "5", а и на дату, т.е. убирала дубликаты, если дата "21.12.2012 - 5" и Вы вносите "21.12.2012 - 5", то не чего не вносится в примечание, а если в примечании "21.12.2012 - 5", а Вы вносите "22.12.2012 - 5", то добавится...
Но в принципе от целей задачи...
Пробуйте

Sub pro()

Dim i&, искомое As Range
On Error Resume Next
    For i = 10 To 15
        If Cells(i, 3).Comment Is Nothing Then
            With Cells(i, 3).AddComment
                .Visible = False
                .Text Cells(7, 2).Value & " - " & Cells(i, 3).Value & Chr(10)
                Cells(i, 3).Comment.Shape.TextFrame.Characters.Font.Bold = True
            End With
        Else
            'что_ищим$ = "*" & Cells(7, 2).Value & " - " & Cells(i, 3).Value & "*"
            'Set искомое = Cells(i, 3).Find(What:=что_ищим$, LookIn:=xlComments, LookAt:=xlWhole)
            '    If искомое Is Nothing Then
                    Cells(i, 3).Comment.Text Cells(i, 3).Comment.Text & Cells(7, 2).Value _
                    & " - " & Cells(i, 3).Value & Chr(10)
            '    End If
        End If
    Next
End Sub

[AllenJ]

Спасибо, работает идеально!