noch offen: Makroproblem Kommentar

Private Sub KommentareEintragen() Dim TB As Worksheet Dim q1 As Range, q2 As Range, q3 As Range, q4 As Range, Bereich As Range Dim i% Set TB = ThisWorkbook.Worksheets("Feiertage") Set q1 = ThisWorkbook.Worksheets("Kalender").Range("C4:CO4") Set q2 = ThisWorkbook.Worksheets("Kalender").Range("C8:CO8") Set q3 = ThisWorkbook.Worksheets("Kalender").Range("C12:CP12") Set q4 = ThisWorkbook.Worksheets("Kalender").Range("C16:CP16") i = 5 Do Until IsEmpty(TB.Cells(i, 2)) 'Datum Feiertage Set Bereich = Union(q1, q2, q3, q4).Cells(TB.Cells(i, 2)) Bereich.NoteText TB.Cells(i, 3) 'Bezeichnung Feiertage i = i + 1 Loop i = 5 Do Until IsEmpty(TB.Cells(i, 5)) 'Datum Spezielle Tage Set Bereich = Union(q1, q2, q3, q4).Cells(TB.Cells(i, 5)) Bereich.NoteText TB.Cells(i, 6) 'Bezeichnung Spezielle Tage i = i + 1 Loop End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub KommentareEintragen() Dim kal As Worksheet Dim dat As Range Dim Bereich As Range Dim i As Integer With Application.Worksheets("Feiertage") Set kal = Application.Worksheets("Kalender") For Each Bereich In .Range("B5:B" & .Cells(.Rows.Count, 5).End(xlUp).Row _ & ", E5:E" & .Cells(.Rows.Count, 5).End(xlUp).Row) For Each dat In kal.Range("C4:CP" & kal.Cells(kal.Rows.Count, 3).End(xlUp).Row) If dat.Value = Bereich.Value Then If dat.Offset(-1, 0).Comment Is Nothing Then dat.NoteText Bereich.Offset(0, 1).Value End If Exit For End If Next dat Next Bereich End With End Sub

Hallo Peter,
habe endlich einen Weg gefunden, schnell und einfach nach Datum über VBA zu suchen. Deshalb hier meine optimierte Lösung für das Eintragen von Kommentaren. Zusätzlich werden bei einem Jahreswechsel die alten Kommentare gelöscht.


Private Sub KommentareEintragen()
Dim kal(1 To 4) As Range
Dim Bereich     As Range
Dim col         As Long
Dim i           As Integer
Dim com         As Comment
With Application.Worksheets("Kalender")
Set kal(1) = .Range("A4:CP4")
Set kal(2) = .Range("A8:CP8")
Set kal(3) = .Range("A12:CP12")
Set kal(4) = .Range("A16:CP16")
On Error Resume Next
'Alte Kommentare löschen nach Erstellung neues Jahr
For Each com In .Comments
com.Delete
Next com
End With
With Application.Worksheets("Feiertage")
For Each Bereich In .Range("B5:B" & .Cells(.Rows.Count, 5).End(xlUp).row _
& ", E5:E" & .Cells(.Rows.Count, 5).End(xlUp).row)
For i = 1 To 4
col = Application.WorksheetFunction.Match(Bereich.Value2, kal(i), 0)
If Err.Number <> 0 Then
Err.Clear
Else
Exit For
End If
Next i
If i <= 4 Then
kal(i).Cells(1, col).NoteText Bereich.Offset(0, 1).Value
End If
Next Bereich
End With
End Sub

Zusätzlich kannst du in VBA in der "Tabelle1" folgenden Code einfügen. Dieser bewirkt, dass bei einer Änderung des Jahreszahl in A3 automatisch die Feiertage neu eingetragen werden.


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$A$3" Then
Tabelle2.Main
End If
End Sub

Danke Alex,
werde ich gleich ausprobieren. Muss das Makro noch anpassen, weil ich unterhalb der Datumszeilen noch andere Zeilen habe (Urlaubsplaner ;-)),

deshalb war auch mein Versuch, die Bereiche mit den Datumszeilen direkt anzusprechen.
Set q1 = ThisWorkbook.Worksheets("Kalender").Range("C5:CO5") '1. Quartal
Set q2 = ThisWorkbook.Worksheets("Kalender").Range("C28:CO28") '2. Quartal
Set q3 = ThisWorkbook.Worksheets("Kalender").Range("C51:CP51") '3. Quartal
Set q4 = ThisWorkbook.Worksheets("Kalender").Range("C74:CP74") '4. Quartal
Set Bereich = Union(q1, q2, q3, q4)
Leider hab ich dein Makro noch nicht so weit, dass es funktioniert :-((, aber irgendwie muss es ja gehen :-)), trotz meiner nichtvorhandenen VBA-Kenntnisse.
Also, nochmal vielen Dank für deine engagierte Hilfe
Gruß Peter

Sub KommentareEintragen() Dim q(1 To 4) As Range Dim Bereich As Range Dim col As Long Dim i As Integer Dim com As Comment With Application.Worksheets("Urlaubsplaner") Set q(1) = .Range("C5:CO5") Set q(2) = .Range("C28:CO28") Set q(3) = .Range("C51:CP51") Set q(4) = .Range("C74:CP74") On Error Resume Next 'Alte Kommentare löschen nach Erstellung neues Jahr For Each com In .Comments com.Delete Next com End With With Application.Worksheets("Feiertage") For Each Bereich In .Range("B5:B" & .Cells(.Rows.Count, 5).End(xlUp).Row _ & ", E5:E" & .Cells(.Rows.Count, 5).End(xlUp).Row) For i = 1 To 4 col = Application.WorksheetFunction.Match(Bereich.Value2, q(i), 0) If Err.Number <> 0 Then Err.Clear Else Exit For End If Next i If i <= 4 Then q(i).Cells(1, col).NoteText Bereich.Offset(0, 1).Value With q(i).Cells(1, col).Comment.Shape .Height = 15 .Width = 80 End With 'Ist normalerweise nicht nötig, da die Kommentare bei Neuanlage nicht 'angezeigt werden. Über das Menü "Ansicht -> Kommentare können 'alle Kommentar ein- bzw. ausgeblendet werden q(i).Cells(1, col).Comment.Visible = False End If Next Bereich End With End Sub

Beliebteste Forumthreads (12 Monate)

noch offen: Makroproblem Kommentar

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread