Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Cells(1, 3).Resize(10, 1)) Is Nothing Then Cancel = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objComment As Comment
Dim objCell As Range
If Not Intersect(Target, Cells(1, 3).Resize(10, 1)) Is Nothing Then
With Target
If .Count = 1 Then
If .Comment Is Nothing Then
Set objComment = .AddComment
Else
Set objComment = .Comment
End If
Set objCell = Tabelle2.Range(Mid$(String:=.Validation.Formula1, Start:=2)).Find( _
What:=.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not objCell Is Nothing Then
With objCell
If Not .Comment Is Nothing Then
With .Comment
With .Shape
objComment.Shape.Width = .Width
objComment.Shape.Height = .Height
End With
Call objComment.Text(Text:=.Text)
End With
End If
End With
Set objCell = Nothing
End If
Set objComment = Nothing
End If
End With
End If
End Sub