• 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.

macro

  • Onderwerp starter Onderwerp starter ppms
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
P

ppms

Gebruiker
Lid geworden
19 aug 2006
Berichten
226
Hoe kan ik in deze formule een macro laten werken. De formule werkt zo prima maar wil dus een macro laten werken na dat cel J is ingevult. Hoop dat het duidelijk is de uitleg.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
'Zodra u een bedrag hebt ingevoerd, wordt de lijst
'gesorteerd en gaat de cursor naar de volgende lege cel in kolom A.
If Intersect(Target, Range("J12:J65536")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    
    'hoe kan ik hier een macro laten werken'
     
    Range("I65536").End(xlUp).Offset(1, 0).Select
    
    Application.ScreenUpdating = True
End Sub

Groet PPMS
 
Had de uitleg niet aangepast in de formule,

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
'Zodra u een getal hebt ingevoerd in kolom J,
'gaat de cursor naar de volgende lege cel in kolom I.

If Intersect(Target, Range("J12:J65536")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    
    'hoe kan ik hier een macro laten werken die in module1 staat'
     
    Range("I65536").End(xlUp).Offset(1, 0).Select
    
    Application.ScreenUpdating = True
End Sub
 
Gewoon de naam van de macro zetten op de plaats waar je het wil uitvoeren.
 
Wigi,

Het wil niet lukken met het plaatsen van de macro, de naam van de macro is WisselOm().
Zou jij eens een voorbeeld kunnen geven hoe ik dit moet doen.

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
'Zodra u een getal hebt ingevoerd in kolom J,
'gaat de cursor naar de volgende lege cel in kolom I.

If Intersect(Target, Range("J12:J65536")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
  
    Range("I65536").End(xlUp).Offset(1, 0).Select
    
    Application.ScreenUpdating = True
End Sub

Groet PPMS
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
'Zodra u een getal hebt ingevoerd in kolom J,
'gaat de cursor naar de volgende lege cel in kolom I.

If Intersect(Target, Range("J12:J65536")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    
    WisselOm
     
    Range("I65536").End(xlUp).Offset(1, 0).Select
    
    Application.ScreenUpdating = True
End Sub

Wat staat er voor code in die procedure?

Wigi
 
Wigi,

Ik had het zelfde gedaan alleen achter WisselOm had ik dit ook nog gezet () en dit was dus de fout. Ik wil je heel vriendelijk bedanken voor de uitleg en heb weer wat geleerd van je.

Groet PPMS
 
Wigi,

Had de vraag al als opgelost ingesteld maar heb toch nog een probleem ik wil namelijk de formule 5 maal gebruiken voor de kolomen J, M, P, S en V maar krijg dan de volgende melding “er is een dubbelzinnige naam gevonden: Worksheet_Change” hoe kan ik dit oplossen.



PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
'Zodra u een getal hebt ingevoerd in kolom J

If Intersect(Target, Range("J12:J65536")) Is Nothing Then Exit Sub
        
    WisselOm
    
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'Zodra u een getal hebt ingevoerd in kolom M

If Intersect(Target, Range("M12:M65536")) Is Nothing Then Exit Sub
        
    WisselOm
    
End Sub

Groet PPMS
 
Had de vraag al als opgelost ingesteld maar heb toch nog een probleem ik wil namelijk de formule 5 maal gebruiken voor de kolomen J, M, P, S en V maar krijg dan de volgende melding “er is een dubbelzinnige naam gevonden: Worksheet_Change” hoe kan ik dit oplossen.
Klik om te vergroten...

Onderstaande code werkt voor alle deze kolommen (dus voor kolommen J, M, P, S en V).

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 11 Then
    Select Case Target.Column
        Case 10, 13, 16, 19, 22
            wisselom
    End Select
End If
End Sub

Met vriendelijke groet,


Roncancio
 
Roncancio en Wigi,

Het werkt nu perfect en ben er heel blij mee, dit scheelt een hoop werk en fouten die er anders bij het invullen van een toernooi worden gemaakt.

Nogmaals jullie bedankt voor de geboden hulp, ik ben super blij.

Ga het programma nog even uit testen en bij oké zal ik dit op de juiste manier "vraag is opgelost" melden.

Groet PPMS
 
Hallo,

Na het testen het volgende,

Kunnen deze macro’s soms een conflict met elkaar hebben/krijgen. A en C staan op toernooi blad, B in module. Als ik C in het programma zet dan na een paar keer gebruiken bij het openen kan ik alleen verder als “alleen lezen” en dit is niet de bedoeling. Kan het programma dan ook niet verwijderen geeft aan dat het in gebruik is door een ander.

A xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx


PHP: 
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

End Sub

B xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx


PHP: 
Public Sub WisselOm()
'
        ActiveSheet.Unprotect (PW)
  Const KolomTeam = 2
  Const MaxRij = 32767
  Const BeginRij = 3
  
  Dim Blad As Object, Rij As Integer, Kolom As Integer
  Set Blad = Worksheets(ActiveSheet.Name)
  Rij = Selection.Row
  
  If Rij > BeginRij Then
    Select Case Selection.Column
    Case 9, 10    'Ronde 1
       Kolom = 8
    Case 12, 13   'Ronde 2
      Kolom = 11
    Case 15, 16   'Ronde 3
      Kolom = 14
    Case 18, 19   'Ronde 4
      Kolom = 17
    Case 21, 22   'Ronde 5
      Kolom = 20
    End Select
  End If
  
  tegen_team = Blad.Cells(Rij, Kolom)
  
  'als home en uit  dan pas ..............
  With Blad.Range(Cells(BeginRij, KolomTeam), Cells(MaxRij, KolomTeam))
      Set teamrij = .Find(tegen_team, LookIn:=xlValues)
  End With
   
  If Cells(teamrij.Row, Kolom + 1) = "" And Cells(teamrij.Row, Kolom + 2) = "" Then
    Cells(teamrij.Row, Kolom + 1) = Cells(Rij, Kolom + 2)
    Cells(teamrij.Row, Kolom + 2) = Cells(Rij, Kolom + 1)
    ActiveSheet.Protect Password:=PW, DrawingObjects:=True, Contents:=True, Scenarios:=True
  End If
End Sub
C xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 11 Then
    Select Case Target.Column
        Case 10, 13, 16, 19, 22
            WisselOm
    End Select
End If
End Sub

Groet PPMS
 
Wat doet code A? Niets. Laat het dan weg.

Dit begrijp ik niet:

Code: 
    Cells(teamrij.Row, Kolom + 1) = Cells(Rij, Kolom + 2)
    Cells(teamrij.Row, Kolom + 2) = Cells(Rij, Kolom + 1)

Wat is het resultaat? In Kolom + 1 én Kolom + 2 staat wat nu in Kolom + 2 staat.

In stuk B schrijf je dingen weg op een blad. Dat wil zeggen dat je het Change event laat uitvoeren. Daardoor kom je (misschien) terug in WisselOm, dus weer Change event, enz.

Kijk dus maar eerst de huidige code na, misschien is het probleem dan al van de baan.

Kan je in het vervolg code tags gebruiken, en niet die van PHP? Bedankt.

Wigi
 
wisselom

Wigi,

Code: 
Cells(teamrij.Row, Kolom + 1) = Cells(Rij, Kolom + 2)
Cells(teamrij.Row, Kolom + 2) = Cells(Rij, Kolom + 1)
Dit moet wisselom doen b.v. plaats 8 ronde stand invullen 13 – 5 dan zou na het invullen door gebruik van de macro wisselom plaats 9 ronde 2 stand 5 -13 komen te staan, dit werkt goed. Laat ik het bovenste weg werkt de macro niet meer.

Alleen na een paar keer het bestand te hebben opgeslagen komt de melding nog “alleen lezen” dit bestand. Ergens klopt het net niet maar kan niet vinden wat het is in de macro wisselom.

Heb het toernooi programma gebruikt bij een toernooi en werkte prima op die dag, alleen na dat ik thuis het bestand nog diversen keren had geopend kwam de fout naar voren.

Code: 
Public Sub WisselOm()
'
        ActiveSheet.Unprotect (PW)
  Const KolomTeam = 2
  Const MaxRij = 32767
  Const BeginRij = 3
  
  Dim Blad As Object, Rij As Integer, Kolom As Integer
  Set Blad = Worksheets(ActiveSheet.Name)
  Rij = Selection.Row
  
  If Rij > BeginRij Then
    Select Case Selection.Column
    Case 9, 10    'Ronde 1
       Kolom = 8
    Case 12, 13   'Ronde 2
      Kolom = 11
    Case 15, 16   'Ronde 3
      Kolom = 14
    Case 18, 19   'Ronde 4
      Kolom = 17
    Case 21, 22   'Ronde 5
      Kolom = 20
    End Select
  End If
  
  tegen_team = Blad.Cells(Rij, Kolom)
  
  'als home en uit  dan pas ..............
  With Blad.Range(Cells(BeginRij, KolomTeam), Cells(MaxRij, KolomTeam))
      Set teamrij = .Find(tegen_team, LookIn:=xlValues)
  End With
   
  If Cells(teamrij.Row, Kolom + 1) = "" And Cells(teamrij.Row, Kolom + 2) = "" Then
    Cells(teamrij.Row, Kolom + 1) = Cells(Rij, Kolom + 2)
    Cells(teamrij.Row, Kolom + 2) = Cells(Rij, Kolom + 1)
    ActiveSheet.Protect Password:=PW, DrawingObjects:=True, Contents:=True, Scenarios:=True
  End If
End Sub

Groet PPMS
 

Bijlagen

ppms zei:
Code: 
Cells(teamrij.Row, Kolom + 1) = Cells(Rij, Kolom + 2)
Cells(teamrij.Row, Kolom + 2) = Cells(Rij, Kolom + 1)
Dit moet wisselom doen b.v. plaats 8 ronde stand invullen 13 – 5 dan zou na het invullen door gebruik van de macro wisselom plaats 9 ronde 2 stand 5 -13 komen te staan, dit werkt goed. Laat ik het bovenste weg werkt de macro niet meer.
Klik om te vergroten...

Je hebt gelijk, teamrij.Row en Rij zijn niet hetzelfde. Dus dat moet er zeker staan.

Waarom het dan ineens alleen lezen wordt weet ik zo direct niet. Volgens mij ligt dat niet aan deze macro.
 
Wigi,

Heb het hele programma opnieuw gemaakt en nu nergens last meer van. Denk dat ik toch nog een vraag heb voor het forum maar kom daar later op terug. Wil iedereen bedanken en het blijft een gebruiksvriendelijk forum Helpmij.

Zal hem als opgelost afmelden.

Groet PPMS
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan