Excel - Commentaar toevoegen via vba

Status
Niet open voor verdere reacties.
D

Delphine01

Gebruiker
Lid geworden
4 mei 2016
Berichten
10
Beste,

Ik zoek de juiste vba-code om automatisch opmerkingen toe te voegen aan de cellen in een bepaald gebied. In het bijgevoegde voorbeeld is dit gebied het bereik binnen het rode kader. Op basis van de lijst in het groene kader zou de juiste opmerking moeten gekozen worden en aan de juiste cel toegevoegd worden. Zo zou de opmerking uit cel AN3 ("Ergonomisch werken") toegevoegd moeten worden in de cellen in het bereik in het rode kader, telkens in de cel rechts naast de cel met dezelfde waarde als in AM3 ("G 1"). Dus de code zou het groene kader moeten doorlopen en voor elke lijn de juiste cellen opzoeken in het bereik in het rode kader om daar de juiste opmerking toe te voegen.
Bijvoorbeeld: "Ergonomisch werken" zou als opmerking moeten toegevoegd worden aan de cellen K5, K14 en O25. Dit zijn telkens de cellen rechts naast de cel waarin "G 1" staat. Voor de tweede lijn in het groene kader zou "Economisch werken" moeten toegevoegd worden als opmerking aan de cellen K6, K15 en AE25.

Ik heb al wat code geprobeerd, maar er gebeurt gewoon niets. Ik weet niet waar ik de fout moet beginnen te zoeken. De code vind je hieronder en is ook ingevoerd in module5 van het bijgevoegde document.
Wie kan me helpen?

Code: 
Sub testOpmerkingenToevoegen()

Dim MijnArrayOmschrijvingBC As Variant  'wat in het groene kader staat
    MijnArrayOmschrijvingBC = Range("$AM$3:$AN$22")

Dim MijnArrayBereik As Variant      'wat in het rode kader staat, het gebied waar de opmerkingen toegevoegd moeten worden
    MijnArrayBereik = Range("$J$2:$AK$31")

Dim Cel As Range

Dim BC As Range

Dim aantalRijenInArrayOmschrijvingBC As Integer
    aantalRijenInArrayOmschrijvingBC = UBound(MijnArrayOmschrijvingBC)

Dim i As Integer

On Error Resume Next
For i = 1 To aantalRijenInArrayOmschrijvingBC
    Set BC = Range(MijnArrayOmschrijvingBC(i, 1))
    
    On Error Resume Next
    For Each Cel In MijnArrayBereik
    
    'Cel.Interior.ColorIndex = 4
    
        If Cel.Value = Range(MijnArrayOmschrijvingBC(i, 1)).Value Then
            Cel.Offset(0, 1).Select
            With Selection
            .ClearComments
            .AddComment MijnArrayOmschrijvingBC(i, 2)
            .Comment.Visible = True
            End With
        End If
    Next
    i = i + 1
Next

End Sub


Bekijk bijlage Voorbeeld commentaar toevoegen.xlsm
 
Laatst bewerkt:
Probeer het zo eens.

Code: 
Sub VenA()
Dim ar, cl, j
ar = Sheets("Evaluatie BC").[AM3].CurrentRegion
For Each cl In [J5:AI30]
    For j = 2 To UBound(ar)
        If cl.Value = ar(j, 1) Then
            With cl.Offset(, 1)
                .ClearComments
                If ar(j, 2) <> "" Then
                    .AddComment ar(j, 2)
                    .Comment.Visible = True
                End If
            End With
            Exit For
        End If
    Next j
Next cl
End Sub
 
Hartelijk bedankt! Dit werkt inderdaad.
Nu heb ik nog 1 vraag. Ik zie dat het bereik [J5:AI30] middenin de programmacode staat.
Hoe krijg ik dit in een variabele bovenaan in mijn code? Kwestie van de variabelen vlot te kunnen aanpassen om code te hergebruiken.

Ik heb er nu dit van gemaakt, maar ik krijg een foutmelding "Object vereist".

Code: 
Dim ar, cel, j, bereik
ar = Sheets("Evaluatie BC").[AM3].CurrentRegion
bereik = Sheets("Evaluatie BC").[J5:AI30]
For Each cel In bereik
    For j = 2 To UBound(ar)
        If cel.Value = ar(j, 1) Then
            With cel.Offset(, 1)
                .ClearComments
                If ar(j, 2) <> "" Then
                    .AddComment ar(j, 2)
                    .Comment.Visible = True
                End If
            End With
            Exit For
        End If
    Next j
Next cel
End Sub
 
Met een kleine aanpassing

Code: 
[COLOR="#FF0000"]Set[/COLOR] bereik = Sheets("Evaluatie BC").[J5:AI30]
 
Met deze kleine aanpassing lukt het inderdaad. Ik ben nog niet helemaal mee met de VBA-redeneringen vrees ik. Want ik probeer nu die lijst met opmerkingen te vullen door de opmerkingen in kolom B over te brengen naar kolom AN. In bijgevoegd voorbeeld kan je dit zien. De code die ik probeerde heb ik in module5 toegevoegd onder de sub testOpmerkingenToevoegen().
Helaas opnieuw foutmeldingen.
Kan je me mijn denkfouten uitleggen?

Dit is de code die ik gebruikte:

Code: 
Sub testCommentaarToevoegen()

Dim ar, j, cl

Set ar = Sheets("Evaluatie BC").[B7:B38]

For Each cl In ar
    For j = 1 To UBound(ar)
        cl.Offset(, 38).Value = ar(j).Comment.Text
    Next j
Next cl

End Sub


Bekijk bijlage Commentaar toevoegen.xlsm
 
Probeer het zo eens.

Code: 
Sub testCommentaarToevoegen()
Dim r, cl
Set r = Sheets("Evaluatie BC").[B7:B38]
For Each cl In r
    cl.Offset(, 38).Value = cl.Comment.Text
Next cl
End Sub
 
Super! Het werkt!
Hopelijk kan ik dit ooit zonder jullie hulp... Alvast bedankt!
 
Da's mooi.

Waarom doe je het eigenlijk niet in één handeling?

Code: 
Sub VenA()
Application.ScreenUpdating = False
Dim cl, cl1
With Sheets("Evaluatie BC")
    For Each cl In .Columns("J:AK").SpecialCells(2)
        For Each cl1 In .Columns(2).SpecialCells(-4144)
            If cl.Value = cl1.Value Then
                cl.ClearComments
                cl.AddComment cl1.Comment.Text
                Exit For
            End If
        Next cl1
    Next cl
End With
End Sub
 

Bijlagen

Controle via Inputbox

Beste,

Nu probeer ik een uitbreiding van de code om gegevensbereiken via een inputbox door de gebruiker te laten bepalen. Dit probeerde ik via de volgende code, maar ik krijg bij de uitvoering fout 438: Deze eigenschap of methode wordt niet ondersteund door dit object.

Code: 
Sub OpmerkingenInvoegenPerBCInOefenfiches2()
'werkt niet......................................................
Dim ar, cel, j, bereik
Dim rngOmschrijvingBC As Range
Dim rngOefenfiches As Range

Set rngOmschrijvingBC = Application.InputBox("Selecteer de lijst van BC's (korte notatie).", "Basiscompetenties invoegen als opmerkingen", Type:=8)
Set rngOefenfiches = Application.InputBox("Selecteer het gebied van de Oefenfiches waarin de opmerkingen moeten toegevoegd worden.", _
                                            "Basiscompetenties invoegen als opmerkingen", Type:=8)
ar = Sheets("Evaluatie BC").rngOmschrijvingBC
Set bereik = Sheets("Evaluatie BC").rngOefenfiches
For Each cel In bereik
    For j = 2 To UBound(ar)
        If cel.Value = ar(j, 1) Then
            With cel.Offset(, 1)
                .ClearComments
                If ar(j, 2) <> "" Then
                    .AddComment ar(j, 2)
                    .Comment.Visible = True
                End If
            End With
            Exit For
        End If
    Next j
Next cel
End Sub

Bij de eerste inputbox zou de gebruiker het bereik AM3:AM22 selecteren, bij de tweede inputbox het bereik J20:AK31.
Ideaal zou zijn als deze waarden ook als standaardwaarden zouden voorgesteld worden zodat de gebruiker eigenlijk bij uitvoeren van de code meteen kan zien of de bereiken nog correct zijn, en deze indien nodig kan aanpassen. Bij aanpassen zouden de nieuwe bereiken dan in de programmacode moeten opgeslagen worden voor een volgende uitvoering van de code.

Wat loopt er fout, en hoe kan ik die bereiken bij de invoervensters laten verschijnen en bij aanpassing ook laten opslaan?

In bijlage een herwerkt bestand.

Bekijk bijlage Voorbeeld commentaar toevoegen (1).xlsm


Groetjes
Delphine
 
Probeer het zo eens. Set bereik ..... moet je dan weghalen.

Code: 
ar = rngOmschrijvingBC
For Each cel In rngOefenfiches
 
Gelukt met deze code! Hartelijk bedankt!!
Code: 
Sub OpmerkingenInvoegenPerBCInOefenfiches2()

Dim ar, cel, j
Dim rngOmschrijvingBC As Range
Dim rngOefenfiches As Range

Set rngOmschrijvingBC = Application.InputBox("Selecteer de eerste BC van de lijst (korte notatie).", "Basiscompetenties invoegen als opmerkingen", Type:=8)
Set rngOefenfiches = Application.InputBox("Selecteer het gebied van de Oefenfiches waarin de opmerkingen moeten toegevoegd worden.", _
                                            "Basiscompetenties invoegen als opmerkingen", Type:=8)
ar = rngOmschrijvingBC.CurrentRegion
For Each cel In rngOefenfiches
    For j = 2 To UBound(ar)
        If cel.Value = ar(j, 1) Then
            With cel.Offset(, 1)
                .ClearComments
                If ar(j, 2) <> "" Then
                    .AddComment ar(j, 2)
                    .Comment.Visible = True
                End If
            End With
            Exit For
        End If
    Next j
Next cel
End Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan