• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Opmerking meenemen

Status
Niet open voor verdere reacties.
robdgr

robdgr

Verenigingslid
Lid geworden
8 sep 2001
Berichten
4.430
Office versie
Microsoft 365
In een bestand gebruik ik een lijst op een hulppagina en deze komt gekoppeld voor op andere bladen.

Wat ik zou willen dat de opmerking op de hulppagina ook voorkomt op de andere bladen, maar ik heb die truc nog niet kunnen vinden. Kopiëren en plakken speciaal leidt tot opmerkingen in cellen die zijn gewijzigd na een tussenvoeging en sortering, dus dat is de oplossing niet.
 

Bijlagen

Zoiets Rob?
Code: 
Sub tst()
 Dim cl
  With Sheets("Blad1")
     For Each cl In [A1:A10]
       If cl > 0 Then
   On Error Resume Next
       cl.Comment.Delete
       d = cl.Offset(, 3).Comment.Text
     cl.AddComment d
   End If
  Next
 End With
End Sub
 
Laatst bewerkt:
Harry,

In het eerste voorbeeld werkte hij precies, maar ik heb het voorbeeld noodgedwongen aangepast, want een VBA-verbouwing lukte me niet. Op de hulp-pagina staat de lijst, die wordt geplakt op de Rabo-pagina en nog twee andere Ing-bladen. In het voorbeeld heb ik ze toegevoegd.
 

Bijlagen

Test1
Code: 
Sub tst2()
On Error Resume Next
For Each cl In [A4:A39]
    If Not cl.Comment Is Nothing Then
        If cl.Comment.Text <> "" Then
            For i = 2 To 4
                With Sheets(i).Columns(1).Find(cl, , xlValues, xlWhole)
                    .AddComment.Text cl.Comment.Text
                End With
            Next
        End If
    End If
Next
End Sub
 
Rudi,

Bijna goed. Heb nog wel de hulppagina Blad5 genoemd, zodat hij buiten het bereik valt. Ik heb de sortering omgedraaid maar dan blijft de opmerking op de bankpagina's in de oude cel staan en wordt hij wel keurig in de nieuwe cel gezet. Hij zou dus eerst alles moeten verwijderen en dan de nieuwe plaatsen.

Het wordt toch echt tijd dat ik mijn VBA-boek eens verder ga doorwerken, want dit red ik zeker nog niet zelf.

Onderstaand de tekst na aanpassing:
Code: 
Sub opmerking_aanvullen()
On Error Resume Next
For Each cl In [A4:A39]
    If Not cl.Comment Is Nothing Then
        If cl.Comment.Text <> "" Then
            For i = 1 To 3
                With Sheets(i).Columns(1).Find(cl, , xlValues, xlWhole)
                    .AddComment.Text cl.Comment.Text
                End With
            Next
        End If
    End If
Next
End Sub
 
Aanvulling op code van Rudi.
Code: 
Sub tst2()
On Error Resume Next
For Each cl In Sheets("hulp").[A4:A39]
    If Not cl.Comment Is Nothing Then
        If cl.Comment.Text <> "" Then
            For i = 2 To 4
                With Sheets(i).Columns(1).Find(cl, , xlValues, xlWhole)
                [COLOR="red"].Comment.Delete[/COLOR] 
                   .AddComment.Text cl.Comment.Text
                End With
            Next
        End If
    End If
Next
End Sub
 
Harry,

Klinkt logisch, maar bij sortering blijft de opmerking in de oude en nieuwe cel staan. Heb nog iets geprobeerd met
Selection.ClearComments
Klik om te vergroten...
maar dat lost het ook niet op.

Heb nu een omweg gevonden:
Code: 
Sub opmerking_aanvullen()
On Error Resume Next
opmerkingen_weg
For Each cl In [A3:A39]
    If Not cl.Comment Is Nothing Then
        If cl.Comment.Text <> "" Then
            For i = 1 To 2
                With Sheets(i).Columns(1).Find(cl, , xlValues, xlWhole)
                .Comment.Delete
                    .AddComment.Text cl.Comment.Text
                End With
            Next
        End If
    End If
Next
End Sub
Code: 
Sub opmerkingen_weg()

    Sheets("samenvatting per rekening").[A3:A39].ClearComments
    Sheets("samenvatting per maand").[A4:A39].ClearComments
End Sub
 
Laatst bewerkt:
Lijkt erop dat je er uit bent Rob?
 
HSV zei:
Lijkt erop dat je er uit bent Rob?
Klik om te vergroten...
Klopt, het werkt zo. Of het de fraaiste oplossing is, weet ik niet. Misschien kijk ik er er later nog een keer naar.
 
Je kan het ook samenvoegen.

Code: 
Sub opmerking_aanvullen()
On Error Resume Next
  Sheets("samenvatting per rekening").[A3:A39].ClearComments
    Sheets("samenvatting per maand").[A4:A39].ClearComments
For Each cl In [A3:A39]
    If Not cl.Comment Is Nothing Then
        If cl.Comment.Text <> "" Then
            For i = 1 To 2
                With Sheets(i).Columns(1).Find(cl, , xlValues, xlWhole)
                .Comment.Delete
                    .AddComment.Text cl.Comment.Text
                End With
            Next
        End If
    End If
Next
End Sub
 
HSV zei:
Je kan het ook samenvoegen.
Klik om te vergroten...
Harry,

Dat vermoedde ik al, maar vind het aanroepen van een andere ook wel wijs. Wat ik eigenlijk bedoelde of je die actie in de for - next kon plaatsen.
 
Staat wel wijs Rob. :d

Ik weet niet of de samenvattingsbladen dezelfde zijn als de 'for i = 1 to 2'.
En je schrijft over sorteren.

Ik probeer het wat na te bootsen, maar kan het niet nauwkeurig bekijken zonder een voorbeeldbestand.
 
Harry,

Het eerder gebruikte voorbeeld even aangepast en de twee macro's toegevoegd.

Met sorteren bedoel ik de lijst op de pagina 'hulp'. Het kan in een jaar gebeuren dat ik een extra post wil toevoegen en daarna sorteer ik die lijst weer, op de twee andere pagina's gaat dat dan automatisch.

Ik heb aangenomen dat
Code: 
For i = 1 To 2
slaat op het aantal bladen.
 

Bijlagen

Probeer het zoeens Rob.

Ook gelijk de sortering mee genomen.
Code: 
Sub opmerking_aanvullen()
[A3:A39].Sort [A2], xlAscending
 On Error Resume Next
'opmerkingen_weg
For Each cl In [A3:A39]
    'If Not cl.Comment Is Nothing Then
        If cl.Comment.Text <> "" Then
            For i = 1 To 2
                With Sheets(i).Columns(1).Find(cl, , xlValues, xlWhole)
                .ClearComments
                    .AddComment.Text cl.Comment.Text
                End With
            Next
        End If
    'End If
Next
End Sub
'Sub opmerkingen_weg()
'
'    Sheets("maand").[A4:A39].ClearComments
'    Sheets("rekening").[A4:A39].ClearComments
'End Sub
 
Harry,

Werkt perfect. Nogmaals dank.
 
Rob, op deze manier is de macro iets universeler qua bereik (toevoegen of verwijderen van items), ook wat betreft het aantal werkbladen (blad hulp moet wel steeds het laatste blad zijn.
Code: 
Sub opmerking_aanvullen()
opmerkingen_weg
On Error Resume Next
For Each cl In Sheets("hulp").Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If Not cl.Comment Is Nothing Then
        If cl.Comment.Text <> "" Then
            For i = 1 To Sheets.Count - 1
                With Sheets(i).Columns(1).Find(cl, , xlValues, xlWhole)
                    .AddComment.Text cl.Comment.Text
                End With
            Next
        End If
    End If
Next
End Sub
Sub opmerkingen_weg()
    For i = 1 To Sheets.Count - 1
        With Sheets(i)
            .Range("A4:A" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearComments
        End With
    Next
End Sub
 
Rudi,

Een andere plicht roept nu: ik kom erop terug.
 
Rudi,

Ik zie niet waar het gebeurt, maar jouw laatste oplossing haalt ook de opmerkingen op de hulp-pagina weg, zodat er nergens meer een staat.
 
Hallo Rob,

Is blad 'hulp' wel je laatste blad in de rij van alle bladen?
 
Harry,

Ik heb hem bewust hernoemd naar Blad99, maar wat mij betreft zoek je niet verder want jouw eerdere oplossing werkt goed
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan