comment toevoegen via VBA

[popipipo]

Via VBA de naam van een feestdag toevoegen in deze kalender werkt op slechts een klein gedeelte niet.
Het gaat niet goed op de zondagen van de maanden oktober, november en december.
Alle overige dagen doen het wel
Wie weet hoe het komt en kan het aanpassen.

 

[snb]

Bij mij is 1 januari:

=DATE($F$1;1;1)

1e kerstdag:

=DATE($F$1;12;25)

2e kerstdag

=DATE($F$1;12;26)

en oudjaar:

=DATE($F$1;12;31)

Kortom: vast is vast; afhankelijkheid van andere cellen lijkt me overbodig.

 

[popipipo]

Het gaat mij niet specifiek om de feestdagen
Als je een lijst met verjaardagen maakt gaat het op dezelfde manier niet goed

 

[Timshel]

De .find-methode gebruiken om datums te vinden blijft een lastige, zeker als de datums het resultaat zijn van een formule.
Misschien is er een betere methode, maar dit werkt iig ook.

Sub tsh()
    Dim Rng As Range
    Dim Cl1 As Range, Cl2 As Range
    Dim Br
    Dim i As Long
    Dim Sh
    
    On Error Resume Next
    For Each Sh In Sheets
        For Each Cl1 In Sh.Cells.SpecialCells(-4144)
            If (Cl1.Row - 4) Mod 27 = 0 Then Cl1.Comment.Delete
        Next
    Next
    On Error GoTo 0
    For Each Cl1 In Sheets("feestdagen").Range("A2:A14").SpecialCells(xlCellTypeFormulas)
        For i = 1 To Sheets.Count - 1
            For Each Cl2 In Sheets(i).UsedRange.SpecialCells(xlCellTypeFormulas, 1)
                If CLng(Cl1) = CLng(Cl2) Then
                    With Cl2.AddComment
                        .Text Cl1.Offset(, 1).Value
                        .Visible = False
                    End With
                    With Cl2.Comment.Shape
                        .SetShapesDefaultProperties
                        .ScaleWidth 1, msoFalse, msoScaleFromTopLeft
                        .ScaleHeight 1, msoFalse, msoScaleFromTopLeft
                    End With
                End If
            Next
        Next
    Next
End Sub

 

[snb]

Ik heb de vaste 'feest'dagen aangepast zoals eerder aangegeven.
Daarna loopt in het bestand dat je plaatste deze code vlekkelings:

Sub M_snb()
    For Each cl In Sheets("maand").Cells.SpecialCells(-4144)
      cl.Comment.Delete
    Next
    
    On Error Resume Next
    sn = Sheets("feestdagen").Range("A2:B14")
    For j = 1 To UBound(sn)
         Sheets("maand").UsedRange.Find(sn(j, 1), , xlValues, 1).AddComment.Text sn(j, 2)
     Next
End Sub

NB. Ik heb 'on error resume next' moeten toevoegen omdat niet alle 'feest'data aanwezig zijn in het werkblad "maand"

 

[Warme bakkertje]

@ Timshel

Mijn ervaring heeft me geleerd dat werken met datums in VBA het beste werkt door ze om te zetten in Double (aangezien datums eigenlijk getallen zijn) dus Cdbl(datum), vooral bij het gebruik van Autofilter lijkt dit toch het meest accurate resultaat te geven.

 

[Timshel]

In mijn code worden data omgezet in Long (Clng). Omdat datums in Excel corresponderen met gehele getallen zie ik de noodzaak niet om een floating-point-type zoals Double te gebruiken. Merk op overigens dat het snb lukt om de .find-methode aan de praat te krijgen. korter = beter.

 

[popipipo]

De code van SNB doet gedeeltelijk wat ik wil.
Hij slaat namelijk nu de zaterdag over?????
Bovendien wil ik het voor 12 bladen (maanden van het jaar)
Daar heb je dan toch geen 12 codes voor nodig.
de code zal dan moet beginnen met zoiets:

For Each Sh In Sheets
 ..

Echter verderop in de gegeven code staat al de sheetnaam vermeld en deze zal er dan weer uit moeten.
Al met al krijg ik het niet goed werkend.

 

[Warme bakkertje]

Sub Allen()
    On Error Resume Next
    sn = Sheets("feestdagen").Range("A2:B14")
    For i = 1 To 12
        For Each cl In Sheets(i).Cells.SpecialCells(-4144)
            cl.Comment.Delete
        Next
        For j = 1 To UBound(sn)
            Sheets(i).UsedRange.Find(sn(j, 1), , xlValues, 1).AddComment.Text sn(j, 2)
        Next
    Next
End Sub

 

[snb]

of juist andersom met slechts 1 lus:

Sub M_snb()
  On Error Resume Next
  sn = Sheets("feestdagen").Range("A2:B14")

  For j=1 to ubound(sn)
    c00=monthname(sn(j,1))

    if instr(c01,c00)=0 then 
      For Each cl In Sheets(c00).Cells.SpecialCells(-4144)
        cl.Comment.Delete
      Next
    end if

    c01=c01 & "_" & monthname(sn(j,1))
    Sheets(c00).UsedRange.Find(sn(j, 1), , xlValues, 1).AddComment.Text sn(j, 2)
  Next
End Sub

@popi

Bij mij wordt de zaterdag (31-12-2016) wél van commentaar voorzien.

 

[popipipo]

Bij mij wordt de zaterdag (31-12-2016) wél van commentaar voorzien.

Dat is dan vreemd want bij mij niet zoals je in #8 ziet
Ook bij oplossing van Rudi doet hij de zaterdag niet.

  c01=c01 & "_" & monthname(sn(j,))

Bij deze regel krijg ik ook een syntax error als ik de code start.

Hier schiet mijn vba kennis toch echt te kort.

 

[HSV]

De eerste code van @snb werkt hier ook niet op 26-12-2016 met wat voor toevoeging of formaat ik ook toepas(W10, MSo 2007).
Vandaag heb ik nog niets gedaan in Excel, maar wilde dit alvast maar melden.

 

[snb]

Moet natuurlijk

c01=c01 & "_" & monthname(sn(j,1))

zijn.

Vaak helpt de 'hand'matige uitvoering van een zoekopdracht.
Daarna lijkt de 'find' buffer geleegd zodat VBA weer fris aan de gang kan. (excel afsluiten en herstarten kan natuurlijk ook).

 

[popipipo]

Ik ben er nog steeds niet uit.
Wat ik ook doe de maanden 1 tm 9 gaan goed en de maanden 10 tm 12 wordt op de zaterdag geen commentaar in gevoerd?

Iemand nog een idee?

 

[Timshel]

Heb je mijn oplossing uit #4 geprobeerd?

 

[popipipo]

Hallo Tim
Als ik jou macro start krijg ik een foutmelding in deze regel:

Set rFoundCell = Sheets(i).UsedRange.Find(CLng(Cl.Value), , xlValues, xlWhole)

Voeg ik meer bladen (maanden) toe dan krijg ik al een foutmelding in deze regel:

 For Each Cl In Sh.Cells.SpecialCells(-4144)

Geen idee of het aan mijn versie excel ligt maar ik ben in bezit van de engelse versie van Excel 2010

 

[Timshel]

Start de macro 'tsh' in plaats van 'invullen'.

 

[popipipo]

Dat had ik niet gezien sorry

Met je code uit #4 krijg ik toch nog een foutmelding in de regel:

With Cl2.AddComment

 

[Timshel]

Deze coderegel uit je oorspronkelijke bestand

If (cl.Row - 4) Mod 27 = 0 Then cl.Comment.Delete

heb ik in eerste instantie laten staan.
De betreffende instructie verwijdert bestaande comments, maar alleen uit bepaalde rijen.
Omdat de rij-indeling in de laatste versie van je bestand gewijzigd is, worden niet meer alle comments verwijderd (geen enkele in feite).
Tenzij er in andere rijen comments staan die per se behouden moeten blijven, dien je de code als volgt aan te passen. Hiermee worden alle comments verwijderd:

Sub tsh()
    Dim Rng As Range
    Dim Cl1 As Range, Cl2 As Range
    Dim Br
    Dim i As Long
    Dim Sh
    
    On Error Resume Next
    For Each Sh In Sheets
        For Each Cl1 In Sh.Cells.SpecialCells(-4144)
            [COLOR="#FF0000"]Cl1.Comment.Delete[/COLOR]
        Next
    Next
    On Error GoTo 0
    For Each Cl1 In Sheets("feestdagen").Range("A2:A14").SpecialCells(xlCellTypeFormulas)
        For i = 1 To Sheets.Count - 1
            For Each Cl2 In Sheets(i).UsedRange.SpecialCells(xlCellTypeFormulas, 1)
                If CLng(Cl1) = CLng(Cl2) Then
                    With Cl2.AddComment
                        .Text Cl1.Offset(, 1).Value
                        .Visible = False
                    End With
                    With Cl2.Comment.Shape
                        .SetShapesDefaultProperties
                        .ScaleWidth 1, msoFalse, msoScaleFromTopLeft
                        .ScaleHeight 1, msoFalse, msoScaleFromTopLeft
                    End With
                End If
            Next
        Next
    Next
End Sub

 

[popipipo]

In het werkelijke bestand komt op de overige regels ook commentaar te staan.
Vandaar die regel; achteraf gezien is dit eigenlijk niet nodig.
Deze code hoeft eigenlijk maar 1 keer per jaar op een leeg bestand uitgevoerd te worden (Door iemand die weinig kennis heeft van excel)

Ik heb deze code op het werkelijke bestand uitgevoerd in 9 seconden staan alle commentaren erin.
Zo snel kan ik het zelf niet.

Nog even verder uittesten maar ik denk dat het wel goed komt.
Hartelijke dank alle mensen die er naar hebben willen kijken.