Fügen Sie Excel-Zellen dynamische Kommentare über VBA hinzu

Question

Ich versuche, Kommentare zu verwenden, um das aktuelle Fälligkeitsdatum einer Aufgabe über ein VBA-Makro anzuzeigen. Meine aktuelle Lösung sieht folgendermaßen aus:

Sub AddDueDates()
Dim strPrefix As String
  strPrefix = ""
  With Range("Target")
If .Comment Is Nothing Then
   .AddComment
End If
.Comment.Visible = True
.Comment.Shape.TextFrame.AutoSize = True
  End With

 With Range("Target").Comment
.Text strPrefix & Range("Source").Text 
End With
End Sub

Ich bin mir absolut bewusst, dass es sich hierbei wahrscheinlich um schlampigen Code handelt, aber ich fange gerade erst wieder an.

Die bisherige Lösung funktioniert für eine einzelne Zelle einwandfrei. Ich habe die Zellen vorher "Ziel" und "Quelle" genannt, anstatt Zellbezüge wie "B12" zu verwenden. Jetzt möchte ich das auf mehrere Zellen ausweiten, je nachdem, welchen Bereich ich vorher ausgewählt habe (z. B. A1:A6).

Die Auswahl, in der Kommentare hinzugefügt werden, entspricht einem Bereich gleicher Größe in einem anderen Arbeitsblatt.

Ich denke, eine Schleife wäre hilfreich, aber ich weiß nicht, wo ich anfangen soll.

Das Bild unten veranschaulicht vielleicht, was ich tun möchte. Die Quelle ist mit dynamischen Daten gefüllt, die ich meinen Kommentaren hinzufügen möchte.

https://i.stack.imgur.com/EsfEa.jpg

Dank im Voraus

Answer 1

Damit sollten Sie loslegen können. Das funktioniert mit Ihrem Beispielfoto, muss aber angepasst werden, wenn die Kommentarquelle ein anderes Arbeitsblatt ist.

Sub AddDates()
Dim targetRng As Range, commentSrcRng As Range
Dim strPrefix As String ' why this variable? You never seem to use it

Set targetRng = Application.InputBox("Please select the target range.  This is the range that will have comments added to each cell", Type:=8)
Set commentSrcRng = targetRng.Offset(0, 3) ' from the screenshot. Will have to tweak if this is a different worksheet.

Dim cel As Range
Dim i As Long
i = 1
For Each cel In targetRng
    If cel.Comment Is Nothing Then
        cel.AddComment
    End If
    cel.Comment.Visible = True
    cel.Comment.Shape.TextFrame.AutoSize = True
    cel.Comment.Text strPrefix & commentSrcRng.Cells(i)
    i = i + 1
Next cel

End Sub