Als waarde van cel "" wordt

Status
Niet open voor verdere reacties.
M

MEradus

Gebruiker
Lid geworden
25 nov 2012
Berichten
287
Hallo,

Ik ben bezig met een rooster in excel en maar ook gebruik van VBA.
Nu ben ik al een tijdje bezig om iets voorelkaar te krijgen maar het wil me niet lukken.

Ik zal uitleggen wat ik graag wil. ( heb ook even een voorbeeldje gepost )

Ik heb een kolom naast de naam van de medewerker met een dienst code erin. Deze is over het algemeen altijd hetzelfde.
Mocht het nu een keer gebeuren dat deze persoon eerder weggaat of later begint. Heb ik een standaard code (AP001).
Nu wil ik, zodra deze code in een cel komt te staan dat er een userform (die ik nog moet maken) naar voren komt die vraagt wat de AangePaste tijden zijn.
De inputrange moet dan automatisch de 2 cellen naast de dienst code zijn. ( Deze range is dus bij elke medewerker verschillend)

Mijn vraag is dus: is dit mogelijk? zo Ja hoe kan ik dat het beste doen, zonder dat ik elke cel(range) apart moet benoemen?

Ik hoop dat mijn vraagstelling duidelijk is!

Groeten Michel

Bekijk bijlage Voorbeeld bestandje.xlsx
 
Het is een geheel leeg bestandje die je geplaatst hebt Michel.
Als jij een Userform maakt met besturingselementen wil ik er best nog wel eens naar kijken.
 
In bladmodule.
Je kan de rode coderegel naar je hand zetten, waar en wat.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 If Intersect(Target, Columns(2)) Is Nothing Then Exit Sub
 If IsEmpty(Cells(Target.Row, 6)) And UCase(Target) Like "AP*" Then
     [COLOR=#ff0000]Target.Offset(, 4) = 1
[/COLOR]   Application.Goto Target
   UserForm1.Show
  End If
End Sub
In userformmodule.
Code: 
Private Sub CommandButton1_Click()
With ActiveCell
  .Offset(, 1) = TextBox1.Text
  .Offset(, 2) = TextBox2.Text
  End With
 Unload Me
End Sub
Private Sub CommandButton2_Click()
 Unload Me
End Sub
 

Bijlagen

Super

Harry,

Dank je wel, zo in het voorbeeld werkt het prima precies zoals ik het wilde hebben!
Maar de '1' die in kolom F gezet wordt is wat minder. Ik heb namelijk een 4 weeks rooster gemaakt met verticaal zoeken en enz.
Dus als er een 1 in kolom F komt zal daar een stukje code verdwijnen.

Ik heb even snel een voorbeeld gemaakt, om je een beetje een beeld te geven.

O ja, zou me kunnen uitleggen hoe ik de range kan aanpassen?
Zodat ik hem over het hele rooster kan gebruiken. ( Leer ik ook weer wat :) )

Alvast bedankt voor het nog een keer kijken.
 

Bijlagen

Zie mijn vorig schrijven over de rode coderegel.
Zet bv:
Code: 
target.offset(,100) = 1
Nu staat er een 1 in kolom 102
Edit: hoeveel kolommen volgen er nog naast.
 
Laatst bewerkt:
Harry, geen kolommen er meer naast.
Dit is een 4 weeks rooster en het tabblad kopieer ik elke
Elke 4 weken en pas ik alleen de datum aan.

Ik zal het rode gedeelte nog een keer bestuderen.
 
Test het eens Michel.

Code: 
Option Explicit
Public Targettext As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Set Rng = Union(Columns("B"), Columns("E"), Columns("H"), Columns("K"), Columns("N"), Columns("Q"), Columns("T"), Columns("X"), Columns("AA"), Columns("AD"), Columns("AG"), Columns("AJ"), Columns("AM"), Columns("AP"), Columns("AQ"), Columns("AU"), Columns("AX"), Columns("BA"), Columns("BD"), Columns("BG"), Columns("BJ"), Columns("BL"), Columns("BO"), Columns("BR"), Columns("BU"), Columns("BX"), Columns("CA"), Columns("CD"))
 If Intersect(Target, Rng) Is Nothing Then Exit Sub
 If UCase(Targettext) Like "AP*" Then
  Application.EnableEvents = False
    Application.Undo
  Application.EnableEvents = True
   Exit Sub
  Else
 If UCase(Target) Like "AP*" Then
  Application.EnableEvents = False
     Application.Goto Target
    UserForm1.Show
   End If
  End If
 Application.EnableEvents = True
 Targettext = ""
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If UCase(Target) Like "AP*" Then
  Targettext = ActiveCell
 Else
   Targettext = ""
  End If
End Sub
 
Hoi Harry,

Dit werkt (bijna) zoals het zou moeten.
Ik heb hem nu aangepast en in mijn rooster gezet, maar als ik nu een selectie maak. Krijg ik een foutmelding,(13) typen komen niet overeen.
Weet jij waar dit aan kan liggen?
Als ik fout opsporing doe geeft hij de foutmelding bij de code wat nu 'vet' gedrukt is/
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
if UCase(Target) Like "AP*" Then
Targettext = ActiveCell
Else
Targettext = ""
End If
End Sub
Klik om te vergroten...

Alvast bedankt voor het kijken!

Verder is het helemaal super! Bedankt!
 
Laatst bewerkt:
Ik kom er zojuist ook achter dat ik de code niet heel gemakkelijk weer terug kan zetten.

Als ik AP* ergens zet krijg ik netjes userform inbeeld en kan ik invoeren, doorvoeren en klaar.
Maar wil ik van die code weer een andere code maken, veranderd hij hem zelf weer aan de "AP*" code. Naar ongeveer 3 á 4 x blijft de andere code staan. Zou je hier ook nog naar willen/kunnen kijken?

BVD
 
Hallo Michel,

Je vraag van 13:33 uur:
Zet onder de beide codes onder de "Dim" instructie.
Code: 
If Selection.Cells.Count > 1 Then Exit Sub
Je vraag van 13:54 uur.
Dit is volgens mij wat je wenste in je bestandje.

Citaat uit je bestand:
Als bovenstaande code veranderd in een aangepaste code dan zou het userform naar voren moeten komen, maar als het eenmaal veranderd is niet nog een keer.
Klik om te vergroten...
 
Laatst bewerkt:
Harry,

Dan is mijn uitspraak een beetje krom geweest denk ik.
Ik bedoelde dat niet het userform steeds naar voren komt als hij "AP*" vindt.
De cell moet 'gewoon' te wijzigen zijn.

Sorry voor mijn kromme uitleg.
 
Hoi,

Verwijder de selectionchange code.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
If Selection.Cells.Count > 1 Then Exit Sub
Set Rng = Union(Columns("B"), Columns("E"), Columns("H"), Columns("K"), Columns("N"), Columns("Q"), Columns("T"), Columns("X"), Columns("AA"), Columns("AD"), Columns("AG"), Columns("AJ"), Columns("AM"), Columns("AP"), Columns("AQ"), Columns("AU"), Columns("AX"), Columns("BA"), Columns("BD"), Columns("BG"), Columns("BJ"), Columns("BL"), Columns("BO"), Columns("BR"), Columns("BU"), Columns("BX"), Columns("CA"), Columns("CD"))
 If UCase(Target) Like "AP*" Then
  Application.EnableEvents = False
     Application.Goto Target
    UserForm1.Show
   End If
 Application.EnableEvents = True
End Sub
 
Je moet de rode regel nog wel even invoegen Michel.
Per ongeluk verwijderd zie ik.
Code: 
[COLOR=#ff0000]If Intersect(Target, Rng) Is Nothing Then Exit Sub
[/COLOR]If UCase(Target) Like "AP*" Then
Nu geldt de code allen op "Rng" kolommen zoals in de code omschreven.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan