• 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 plaatsen in cel

Status
Niet open voor verdere reacties.
danny147

danny147

Terugkerende gebruiker
Lid geworden
29 apr 2007
Berichten
4.744
Beste,

Graag zou ik een cel een opmerking willen voegen met VBA met volgende voorwaarden:

- Moet zoeken in kolom D of de cel begint met "Controle"
- Indien waar moet hij zoeken via ordernummer in kolom C met Vert.Zoeken naar de Gatekeeper Datum op Blad2
- Deze Datum moet hij dan vervolgens in de opmerking plaatsen in Kolom D starten met GK: + Datum
- Gelieve de code zo op te maken startend met For Each cl In .Range("D" & iRowStart + 1, "D" & iRowEinde)

Zo kan ik dit stukje code in een ander bestandje plaatsen.
In bijlage een voorbeeldje met gegevens.
 

Bijlagen

  • Voorbeeld van opmerking.xlsx
    14,5 KB · Weergaven: 37
Werkt dit voor je?

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iRowStart, iRowEinde As Long
iRowStart = Range("D3").Row
iRowEinde = Range("D3").End(xlDown).Row
For Each cl In Range("D" & iRowStart + 1, "D" & iRowEinde)
    If Left(cl, 8) = "Controle" And cl.Comment Is Nothing Then
        cl.AddComment
        cl.Comment.Visible = False
        cl.Comment.Text Text:="GK: " & CDate(Application.VLookup(cl.Offset(0, -1).Value, Blad2.Range("F2:K1000"), 6, 0))
    End If
Next
End Sub
 
Laatst bewerkt:
Zo misschien:
Code: 
Sub Cobbe()
Dim cl As Range
 For Each cl In Range("D4:D" & Range("D" & Rows.Count).End(xlUp).Row)
  cl.ClearComments
   If Left(cl, 8) = "Controle" Then
    cl.AddComment
     dt = Sheets(2).Range("F:F").Find(cl.Offset(, -1)).Address
      cl.Comment.Text Text:="GK: " & Sheets(2).Range(dt).Offset(, 5)
  End If
Next
End Sub
 
Beste

Ben met de laatste code eerst begonnen, die van Cobbe dus en deze werkt in het bestaande bestandje.
Nu wil ik de code aanpassen en verwijzen naar het bestand waar de gegevens normaal zou moeten opgeladen worden en deze pad is
="file:\\sidmar.be\dfs\Dienst\GROEP\LAD\LPK\Planning\Systeem\Laatste versie\Danny\output.xlsx.Sheet RawData 2!"

Kan je de code aanpassen met deze verwijzing naar de file zodat deze zou kunnen werken want bij mij lukt het niet
Waarschijnlijk door punten of backslash die niet goed staan
 
Beste,

Een beetje gezocht en bij deze lukt het maar nu moet ik nog het bestandje Output.xlsx zien te sluiten
in welke regel moet ik deze steken.

Code: 
Sub Cobbe()
Dim cl As Range
 For Each cl In Range("D4:D" & Range("D" & Rows.Count).End(xlUp).Row)
  cl.ClearComments
   If Left(cl, 8) = "Controle" Then
    cl.AddComment
    Workbooks.Open Filename:="file:\\sidmar.be\dfs\Dienst\GROEP\LAD\LPK\Planning\Systeem\Laatste versie\Danny\Output.xlsx"
    dt = Sheets("Rawdata 2").Range("F:F").Find(cl.Offset(, -1)).Address
    cl.Comment.Text Text:="GK: " & Sheets("Rawdata 2").Range(dt).Offset(, 12)
  End If
Next
End Sub
 
Je kan het bestand beter buiten de lus openen. Dan wordt het zoiets

Code: 
  With GetObject("file:\\sidmar.be\dfs\Dienst\GROEP\LAD\LPK\Planning\Systeem\Laatste versie\Danny\Output.xlsx")
    For Each cl In ThisWorkbook.Sheets("Blad1").Range("D4:D" & Range("D" & Rows.Count).End(xlUp).Row)
      cl.ClearComments
      If Left(cl, 8) = "Controle" Then
        cl.AddComment
        dt = .Sheets("Rawdata 2").Range("F:F").Find(cl.Offset(, -1)).Address
        cl.Comment.Text Text:="GK: " & Sheets("Rawdata 2").Range(dt).Offset(, 12)
      End If
    Next
    .Close 0
  End With
 
Code: 
dim wb as worksheet, cl as range, dt as range
With GetObject("file:\\sidmar.be\dfs\Dienst\GROEP\LAD\LPK\Planning\Systeem\Laatste versie\Danny\Output.xlsx")
 set wb = ThisWorkbook.Sheets("Blad1")
    For Each cl In wb.range("D4:D" & wb.cells(rows.count, 4).End(xlUp).Row)
      If Left(cl, 8) = "Controle" Then
         cl.ClearComments
         set dt = .Sheets("Rawdata 2").columns(6).Find(cl.Offset(, -1),,, 1)
       if not dt is nothing then cl.AddComment "GK: " & dt.Offset(, 12).value
     End If
    Next
.Close 0
End With
 
Laatst bewerkt:
Beste,

Bedankt voor het zoeken :thumb:

@ VenA,
Met jouw code krijg ik een foutmelding: "Het Subscript valt buiten het bereik" op volgende regel

Code: 
cl.Comment.Text Text:="GK: " & Sheets("Rawdata 2").Range(dt).Offset(, 12)

@ HSV,
Jouw code doet het prima
Heb wat aanpassingen moeten doen om in het bestaande bestandje het werkende te houden

Code: 
        Dim wb As Worksheet, cl As Range, dt As Range

        With GetObject("file:\\sidmar.be\dfs\Dienst\GROEP\LAD\LPK\Planning\Systeem\Laatste versie\Danny\Output.xlsx") 'Workbook gaat open en is niet zichtbaar
            Set wb = ThisWorkbook.Sheets("Orders opvragen")
        For Each cl In wb.Range("D" & iRowStart + 1 & ":" & "D" & iRowEinde)
            If Left(cl, 11) = "Controle LK" Or Left(cl, 11) = "Controle TK" Then
            cl.ClearComments
            Set dt = .Sheets("Rawdata 2").Columns(6).Find(cl.Offset(, -1), , , 1)
        If Not dt Is Nothing Then cl.AddComment "GK: " & dt.Offset(, 12).Value
        End If
            Next
            .Close 0
        End With

Bedankt allen ;)
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan