Kommentare Feiertage in Zeile

[Andyle]

Erstmal allen ein gesundes neues Jahr

Ich arbeite gerade an einem Makro, der Kommentare in Zellen setzt wenn dies ein Feiertag ist.
Mein Code der auch funktioniert:

Code:

Sub Kommentar()

Dim zaehler As Long

'Kommentare löschen
Range("C9:AG9").Select
Selection.ClearComments
Range("A1").Select

'Schleife
For zaehler = 3 To 33 'schleife von Zeile 9 ,Zelle 3 bis 33
If Cells(9, zaehler).Comment Is Nothing Then 'fehler abfangen wenn bereits ein kommentar vorhanden

If Cells(6, zaehler).Text = 1 Then
Cells(9, zaehler).AddComment Cells(27, zaehler).Text
Cells(9, zaehler).Comment.Shape.TextFrame.AutoSize = True
Else
Cells(9, zaehler).ClearComments
End If

End If
Next
End Sub

Nun mein Problem:
Cells(27, zaehler).Text , da kann sich immer die Zeile je nach Einträgen verschieben.

Ermittel tu ich momentan den Text in Zeile 27 mit folgender Formel:
=WENNFEHLER(SVERWEIS(C$25;Feiertage!$A$6:$B$28;2;0);"")

Die Feiertage stehen in 
TB Feiertage Range(A6:A28) (Datum)
TB Feiertage Range(B6:B28) (Text was für ein Feiertag)

Wie bekomme ich es hin, die Feiertage variabel unabhängig der Zeile 27 als Kommentartext einzutragen?

Ich danke Euch

[Andyle]

So, ich habe es jetzt mit letzter Zeile ermitteln gelöst.
Ist wohl nicht die intelligenteste Lösung, aber funzt super.

[ralf_b]

die Lösung wäre evtl. interessant für Lösungssuchende.

eine Anmerkung zu deinem Code. Zu Beginn werden im Bereich alle Comments gelöscht. Anschließend fragst du in der Schleife ob in der Zelle ein Comment ist.  
darin die Abfrage  Cells(6, zaehler).Text = 1  auf deren Ergebnis ein Comment gesetzt wird andernfalls wieder ein möglicher Comment gelöscht wird. 

Ziehmlich viel löschen.

[RPP63]

Moin!
Ich stelle hier mal kommentarlos( ) eine etwas ältere Version ein.
Hier wird auch berücksichtigt, dass an einem Tag mehrere Feiertage sein können.
Einfach mal ein wenig mit dem Jahr spielen.
Der relevante Code steht im Tabellenblatt "Block".

Gruß Ralf

[Andyle]

So, hab die Abfrage noch entfernt. Danke für den Hinweis.

Jetzt lese ich alle vorhandenen Kommentare in der Zeile aus. (funzt)

Wie bekomme ich die ausgelesenen Kommentare in meine MsgBox rein, so dass die MsgBox außerhalb der Schleife ist, da sonst die MsgBox ja mehrfach aufpoppen würde?

Code:

'Kommentare setzen
Dim zaehler As Long

'Kommentare löschen
Range("C9:AG9").Select
Selection.ClearComments
Range("A1").Select

letztezeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

'Schleife
For zaehler = 3 To 33 'schleife von Zeile 9 ,Zelle 3 bis 33

If Cells(6, zaehler).Text = 1 Then
Cells(9, zaehler).AddComment Cells(letztezeile, zaehler).Text
Cells(9, zaehler).Comment.Shape.TextFrame.AutoSize = True

MsgBox Cells(9, zaehler).Comment.Text 'Dieser Kommentartext soll untereinander in die MsgBox unter dem Code!

Else
Cells(9, zaehler).ClearComments
End If

Next
'Kommentar Ende


MsgBox "Der Monat " & """" & ActiveSheet.Range("K3") & ". " & ActiveSheet.Range("L3") & """" & " wurde erstellt!" & vbLf & vbLf & "Es gib " & ActiveSheet.Range("B6") & " Feiertage in diesem Monat!" & vbLf & vbLf & Cells(9, zaehler).Comment.Text, vbInformation, "Monat erstellt!"

Danke

[Andyle]

So, hab die Abfrage noch entfernt. Danke für den Hinweis.

Jetzt lese ich alle vorhandenen Kommentare in der Zeile aus. (funzt)

Wie bekomme ich die ausgelesenen Kommentare in meine MsgBox rein, so dass die MsgBox außerhalb der Schleife ist, da sonst die MsgBox ja mehrfach aufpoppen würde?

Code:

'Kommentare setzen
Dim zaehler As Long

'Kommentare löschen
Range("C9:AG9").Select
Selection.ClearComments
Range("A1").Select

letztezeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

'Schleife
For zaehler = 3 To 33 'schleife von Zeile 9 ,Zelle 3 bis 33

If Cells(6, zaehler).Text = 1 Then
Cells(9, zaehler).AddComment Cells(letztezeile, zaehler).Text
Cells(9, zaehler).Comment.Shape.TextFrame.AutoSize = True

'MsgBox Cells(9, zaehler).Comment.Text 'Dieser Kommentartext soll untereinander in die MsgBox unter dem Code!
Kommentar = Cells(9, zaehler).Comment.Text
Adress = Cells(9, zaehler).Value

Else
Cells(9, zaehler).ClearComments
End If

Next
'Kommentar Ende

MsgBox "Der Monat " & """" & ActiveSheet.Range("K3") & ". " & ActiveSheet.Range("L3") & """" & " wurde erstellt!" & vbLf & vbLf & "Es gib " & ActiveSheet.Range("B6") & " Feiertage in diesem Monat!" & vbLf & vbLf & Adress & " - " & Kommentar, vbInformation, "Monat erstellt!"

Danke

---

Anbei ein Screen.

[Andyle]

So, weitere Erfolge

Nur wie bekomme ich es jetzt angeordnet?
So sollte es dann aussehen!

Der Monat "4. 2023" wurde erstellt!
Es gib 2 Feiertage in diesem Monat!

07.04.2023 - Karfreitag
10.04.2023- Ostermontag

Code:

'Kommentare setzen
Dim zaehler As Long

'-----------
Dim Adress2() As Variant
Dim col As New Collection
Dim cola As New Collection
'----------------

'Kommentare löschen
Range("C9:AG9").Select
Selection.ClearComments
Range("A1").Select

letztezeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

'Schleife
For zaehler = 3 To 33 'schleife von Zeile 9 ,Zelle 3 bis 33

If Cells(6, zaehler).Text = 1 Then
Cells(9, zaehler).AddComment Cells(letztezeile, zaehler).Text
Cells(9, zaehler).Comment.Shape.TextFrame.AutoSize = True

'MsgBox Cells(9, zaehler).Comment.Text 'Dieser Kommentartext soll untereinander in die MsgBox unter dem Code!
Kommentar = Cells(9, zaehler).Comment.Text
Adress = Cells(9, zaehler).Value

'----------------------
col.Add (Cells(9, zaehler).Value)
cola.Add (Cells(9, zaehler).Comment.Text)
'----------------------

End If

Next

'------------------------
Dim i As Variant, res As String
Dim d As Variant, resa As String

For Each i In col
res = res & "- " & i
Next
res = Right(res, Len(res) - 2)

For Each d In cola
resa = resa & "- " & d
Next
resa = Right(resa, Len(resa) - 2)
'-------------------------

'Kommentar Ende

MsgBox "Der Monat " & """" & ActiveSheet.Range("K3") & ". " & ActiveSheet.Range("L3") & """" & " wurde erstellt!" & vbLf & vbLf & "Es gib " & ActiveSheet.Range("B6") & " Feiertage in diesem Monat!" & vbLf & vbLf & res & " - " & resa & vbLf, vbInformation, "Monat erstellt!"

[Andyle]

So, da sich ja hier keiner der Hilfe bewusst ist, mein Code.

Sicherlich nicht die feinste Lösung, aber funzt bestens!

Code:

'------------------------
Dim i As Variant, DatumFt As String
Dim d As Variant, NameFt As String

For Each i In col
DatumFt = DatumFt & " , " & i
Next
DatumFt = Right(DatumFt, Len(DatumFt) - 2)


For Each d In cola
NameFt = NameFt & " , " & d
Next
NameFt = Right(NameFt, Len(NameFt) - 2)
'-------------------------

Dim a() As String
Dim t() As String

Dim k As Integer

a = Split(DatumFt, ",")
Dim s As String
s = ""
For k = LBound(a) To UBound(a)
s = s & a(k)
Next k


Dim p As Integer
t = Split(NameFt, ",")
Dim z As String
z = ""
For p = LBound(t) To UBound(t)
z = z & t(p)
Next p


If ActiveSheet.Range("B6") = 1 Then
Ft_1 = a(0) & " - " & t(0)
End If

If ActiveSheet.Range("B6") = 2 Then
Ft_1 = a(0) & " - " & t(0) & vbLf
Ft_2 = a(1) & "  - " & t(1)
End If

If ActiveSheet.Range("B6") = 3 Then
Ft_1 = a(0) & " - " & t(0) & vbLf
Ft_2 = a(1) & " - " & t(1) & vbLf
Ft_3 = a(2) & "  - " & t(2)
End If

If ActiveSheet.Range("B6") = 4 Then
Ft_1 = a(0) & " - " & t(0) & vbLf
Ft_2 = a(1) & " - " & t(1) & vbLf
Ft_3 = a(2) & " - " & t(2) & vbLf
Ft_4 = a(3) & "  - " & t(3)
End If

If ActiveSheet.Range("B6") = 5 Then
Ft_1 = a(0) & " - " & t(0) & vbLf
Ft_2 = a(1) & " - " & t(1) & vbLf
Ft_3 = a(2) & " - " & t(2) & vbLf
Ft_4 = a(3) & " - " & t(3) & vbLf
Ft_5 = a(4) & "  - " & t(4)
End If

End If

[ralf_b]

da sich ja hier keiner der Hilfe bewusst ist,

seltsame Formulierung. Dir wurde doch geholfen und das Beste ist, du hast dir selbst geholfen. Am Ende lese ich "der Code funzt bestens". Also gibt es nichts zu meckern.