Kommentarfeld füllen mit Zellinhalten
Constantin
mit nachstehendem (angepasstem) Programm sollen Zellinhalte (von Tabelle1) gemäß der Zelladresse, die in Spalte 11
steht, nach Tabelle2 in ein Kommentarfeld (mit der gleichen Zelladresse) übertragen werden. Die Tabelle1
wird hierbei durchlaufen, bis alle Einträge (Zeilen) abgearbeitet sind.
Leider komme ich nicht ganz zurecht, weitere Spalteninhalte zu berücksichtigen. Ich erhalte keine Kommentarfeld-Einträge.
Insgesamt habe ich nun 12 Spalten in Tabelle1. Diese Spalteninhalte möchte ich zeilenweise strukturiert in ein Kommentarfeld übertragen:
Die Spalten 2,3,4,5, 6 und 7 sollen - jeweils getrennt durch " / " die erste Zeile des
Kommentarfeldes bilden. In der folgenden Zeile soll der Zellinhalt von Spalte 8 stehen, in der nächsten Zeile der Inhalt von Spalte 1. Danach sollen nach einer Leerzeile die Spalteninhalte 9, 10, 11 und 12 (ebenfalls getrennt durch " / ") in eine Zeile geschrieben werden. Zum Schluss soll darunter eine Linie mit der Länge 50 in das Kommentarfeld eingefügt werden.
Ist bereits ein Kommentar vorhanden, wird ein folgender (mit gleicher Zelladresse) mit obiger
Struktur (mit einer Leerzeile dazwischen) angehängt.
Vielleicht habe ich auch den Befehl Offset falsch interpretiert. Wo liegt der Fehler?
Im voraus vielen Dank für eure Unterstützung.
Grüße, Constantin
Sub addComment()
Dim rng As Range, rngCmnt As Range
Dim strTest As String
With Sheets("Tabelle1")
For Each rng In .Range("A1:A" & CStr(.Cells(Rows.Count, 1).End(xlUp).Row))
If rng "" Then
On Error Resume Next
Set rngCmnt = Sheets("Tabelle2").Range(rng.Offset(0, 11).Text)
On Error GoTo 0
Err.Clear
If Not rngCmnt Is Nothing Then
strTest = _
rng.Text & vbCrLf & _
rng.Offset(0, -9) & " / " & rng.Offset(0, -8) & " / " & rng.Offset(0, -7) & " / _
" & _
rng.Offset(0, -6) & " / " & rng.Offset(0, -5) & " / " & rng.Offset(0, -4) & _
vbCrLf & _
rng.Offset(0, -3) & vbCrLf & _
rng.Offset(0, -10) & vbCrLf & vbCrLf & _
rng.Offset(0, -2) & " / " & rng.Offset(0, -1) & " / " & rng.Offset(0, 0) & " / " _
& _
rng.Offset(0, 1) & vbCrLf & String(50, "_")
If rngCmnt.Comment Is Nothing Then
rngCmnt.addComment strTest
rngCmnt.Comment.Shape.DrawingObject.AutoSize = True
Else
rngCmnt.Comment.Shape.TextFrame.Characters.Text = _
rngCmnt.Comment.Text & vbCrLf & strTest
End If
End If
End If
Set rngCmnt = Nothing
Next
End With
Set rng = Nothing
End Sub
Anzeige