Meerdere voorwaarden

Status
Niet open voor verdere reacties.
G

gpiket7

Gebruiker
Lid geworden
25 jul 2008
Berichten
169
Met de volgende code is het mogelijk een keuzelijst te generen naar aanleiding van een bepaalde voorwaarde, is het ook mogelijk om 2 waardes in te stellen?

Dus iets uit kolom D en kolom E.
Bijvoorbeeld kolom D is Regio en kolom E is Zuid.

Code: 
If Not Application.Intersect(Target, Range("C10:C100")) Is Nothing Then
    If Target.Value = "Landelijk" Then
        Sheets("UMG").Select
        ActiveWorkbook.Names("keuze2").Delete
        ActiveWorkbook.Names.Add Name:="keuze2", RefersToR1C1:="=UMG!R2C32:R2C32"
        Sheets("UMG").Select
    Else
    If Target.Value = "Regio" Then
       Sheets("UMG").Select
       ActiveWorkbook.Names("keuze2").Delete
       ActiveWorkbook.Names.Add Name:="keuze2", RefersToR1C1:="=UMG!R2C33:R6C33"
       Sheets("UMG").Select
    Else
    If Target.Value = "Vestiging" Then
        Sheets("UMG").Select
        ActiveWorkbook.Names("keuze2").Delete
        ActiveWorkbook.Names.Add Name:="keuze2", RefersToR1C1:="=UMG!R2C33:R6C33"
        Sheets("UMG").Select
    End If
End If
End If
End If
 
in principe kan dit gedaan worden op dezelfde wijze zoals je nu keuzes maakt tussen de verschillende niveaus. Mogelijk kan het wat vereenvoudigd worden afhankelijk van wat er moet veranderen aan de hand van de tweede keuze.
 
Hierbij een voorbeeld bestand
Afhankelijk van de kolom C en D moet kolom E gegevens tonen.

Stel in kolom C staat Regio
in kolom D staat West
Dan wil ik dat er bepaalde gegeens komen te staan

Staat er in kolom C: Vestiging
en in kolom D staat: West
Dan moeten het andere gegevens worden.
 
Laatst bewerkt:
ik denk dat het duidelijk is. Overigens bevat je voorbeeld file nog redelijk wat gevoelige informatie, ik zou dan ook aanraden een iets schoner voorbeeld te nemen ;)

Zijn de regio's vast? of verwacht je veel updates aan je validatie tabellen? Je kunt hier ook kiezen voor een form, waar je een popup krijgt aan de hand van de keuzes in kolom C en D. Dit heeft als voordeel dat je de validatie niet per lijn hoeft op te bouwen.
 
Is dat zo, ik zag niet al te veel gevoelige info meer...
Maar zal er nog eens naar kijken.

in de regio's verwacht ik weinig wijzigingen, maar kan altijd gebeuren.
Ik heb geen idee hoe het met een pop up er uit zou komen te zien...

Ik heb nu steeds een drop down box
 
Met deze code op page1 kun je doen wat je wilt. Ik heb nu de keuzes hard gecodeerd. Dit is natuurlijk niet ideaal, maar volgens mij moet je met dit voorbeeld een heel eind komen om de uiteindelijke oplossing te vinden.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Application.Intersect(Target, Range("c:d")) Is Nothing Then
        Dim myRange As String
        If Cells(Target.Row, 3).Value = "Landelijk" Then
            myRange = "=AF2:AF4"
        End If
        
        If Cells(Target.Row, 3).Value = "Regio" Then
            If Cells(Target.Row, 4).Value = "Zuid Oost" Then
                myRange = "=AP2:AP15"
            End If
            If Cells(Target.Row, 4).Value = "West" Then
                myRange = "=AQ2:AQ12"
            End If
            If Cells(Target.Row, 4).Value = "Zuid West" Then
                myRange = "=AO2:AO14"
            End If
            If Cells(Target.Row, 4).Value = "Noord Oost" Then
                myRange = "=AR2:AR17"
            End If
            If Cells(Target.Row, 4).Value = "LVO" Then
                myRange = "=AS2:AS4"
            End If
            
        End If
        
        If myRange <> "" Then
            Cells(Target.Row, 5).Validation.Modify xlValidateList, xlValidAlertStop, xlBetween, myRange
        End If
        
    End If
    
End Sub
 
Laatst bewerkt:
Ik heb de bijlage verwijders, had de verkeerde geupload...
Maar jou stukje code werkt bij niet...

Ik krijg het stukje van de vestiging hier niet tussen, da pakt hij hetzelfde als bij de Regio.
En het stukje van het landelijk werkt helemaal niet meer
 
als je een nieuw voorbeeld hebt wil ik de code wel inpassen. Ik wil ook mijn versie wel uploaden, maar daar staat ook weer die informatie in.

Overigens doet mijn code alleen landelijk en regio, omdat ik niet goed begreep wat er onder de andere optie moest komen.

Ik kijk even of ik mijn versie can cleanen en uploaden
 
Ik heb even mijn versie opgeschoond en alle onnodige informatie verwijderd. Bij het openen even de warning negeren of de extentie naar XLSM veranderen. Dit omdat het forum uploaden van xlsm files niet toestaat.

Je zou nu twee opties moeten zien, landelijk en regio. Indien je landelijk selecteerd doet de formule niets met de tweede kolom en krijg je altijd slechts 2 opties. Indien je regio selecteerd en de bijbehorende regio krijg je in kolom E slechts steden in die regio.

Overigens krijg je nu altijd een optie omdat je de validation al een standaard lijst hebt gegeven (keuze 3) eventueel kun je ook hier standaard verwijzen naar een lege lijst.
 

Bijlagen

Ik heb even opgeschreven welke keuze mogelijkheden je zou moete krijgen, want ik krijg het met jouw code niet voor elkaar, ik hoop dat je het begrijpt, anders hoor ik het graag

Impact Regio Vestiging

Landelijk Alle Regio's AN4
Regio Zuid West AO2
Regio Zuid Oost AP2
Regio West AQ2
Regio Noord Oost AR2
Regio LVO AS2
Vestiging Zuid West AO3 t/m AO14
Vestiging Zuid Oost AP3 t/m AP15
Vestiging West AQ3 t/m AQ12
Vestiging Noord Oost AR3 t/m AR17
Vestiging LVO AS3 t/m AS4
 
Ik heb mijn voorbeeld een beetje aangepast, het is nu meer in de lijn van je voorbeeld. Ik heb voor de 'landelijk' en 'regio' settings een default ingeschakeld voor kolom E, ipv te verwijzen naar een cel. Dit maakt het beheer wat makkelijker. Uiteraard kun je het een beetje verder uitwerken voor meer keuzes, maar met de code voor de vestigingen moet je daar ook wel uitkomen :cool:

W
 

Bijlagen

Wampier, hier kan ik mee verder en het werk, super.
Alleen mijn stuk code wat er na moet komen, doet het nu niet meer...?!

Mijn volledige code (zonder meerdere voorwaarden):
Code: 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim myRange As Range
Dim r As Integer

If Not Application.Intersect(Target, Range("C10:C100")) Is Nothing Then
    If Target.Value = "Landelijk" Then
        Sheets("UMG").Select
        ActiveWorkbook.Names("keuze2").Delete
        ActiveWorkbook.Names.Add Name:="keuze2", RefersToR1C1:="=UMG!R2C32:R4C32"
        Sheets("UMG").Select
    Else
    If Target.Value = "Regio" Then
       Sheets("UMG").Select
       ActiveWorkbook.Names("keuze2").Delete
       ActiveWorkbook.Names.Add Name:="keuze2", RefersToR1C1:="=UMG!R2C33:R6C33"
       Sheets("UMG").Select
    Else
    If Target.Value = "SBC" Then
        Sheets("UMG").Select
        ActiveWorkbook.Names("keuze2").Delete
        ActiveWorkbook.Names.Add Name:="keuze2", RefersToR1C1:="=UMG!R2C34:R2C34"
        Sheets("UMG").Select
    End If
End If
End If
End If
If Not Application.Intersect(Target, Range("D10:D100")) Is Nothing Then
    If Target.Value = "Alle Regio's" Then
        Sheets("UMG").Select
        ActiveWorkbook.Names("keuze3").Delete
        ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C40:R3C40"
        Sheets("UMG").Select
    Else
    If Target.Value = "Meeùs" Then
        Sheets("UMG").Select
        ActiveWorkbook.Names("keuze3").Delete
        ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R5C40:R5C40"
        Sheets("UMG").Select
    Else
    If Target.Value = "Unirobe" Then
        Sheets("UMG").Select
        ActiveWorkbook.Names("keuze3").Delete
        ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R6C40:R6C40"
        Sheets("UMG").Select
    Else
        If Target.Value = "Landelijk" Then
        Sheets("UMG").Select
        ActiveWorkbook.Names("keuze3").Delete
        ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R4C40:R4C40"
        Sheets("UMG").Select
    Else
    If Target.Value = "Zuid West" Then
       Sheets("UMG").Select
       ActiveWorkbook.Names("keuze3").Delete
       ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C41:R14C41"
       Sheets("UMG").Select
    Else
    If Target.Value = "Zuid Oost" Then
       Sheets("UMG").Select
       ActiveWorkbook.Names("keuze3").Delete
       ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C42:R15C42"
       Sheets("UMG").Select
    Else
    If Target.Value = "West" Then
       Sheets("UMG").Select
       ActiveWorkbook.Names("keuze3").Delete
       ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C43:R12C43"
       Sheets("UMG").Select
    Else
    If Target.Value = "Noord Oost" Then
       Sheets("UMG").Select
       ActiveWorkbook.Names("keuze3").Delete
       ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C44:R17C44"
       Sheets("UMG").Select
    End If
    If Target.Value = "LVO" Then
       Sheets("UMG").Select
       ActiveWorkbook.Names("keuze3").Delete
       ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C44:R4C44"
       Sheets("UMG").Select
    End If
End If
End If
End If
End If
End If
End If
End If
End If

If Not Application.Intersect(Target, Range("F10:F100")) Is Nothing Then
    If Target.Value = "Bedrijfsapplicatie" Then
        Sheets("UMG").Select
        ActiveWorkbook.Names("keuze5").Delete
        ActiveWorkbook.Names.Add Name:="keuze5", RefersToR1C1:="=UMG!R2C52:R28C52"
        Sheets("UMG").Select
    Else
    If Target.Value = "Afhankelijkheden" Then
       Sheets("UMG").Select
       ActiveWorkbook.Names("keuze5").Delete
       ActiveWorkbook.Names.Add Name:="keuze5", RefersToR1C1:="=UMG!R2C51:R10C51"
       Sheets("UMG").Select
    Else
    If Target.Value = "Kantoorapplicatie" Then
       Sheets("UMG").Select
       ActiveWorkbook.Names("keuze5").Delete
       ActiveWorkbook.Names.Add Name:="keuze5", RefersToR1C1:="=UMG!R2C53:R4C53"
       Sheets("UMG").Select
    End If
    If Target.Value = "Systeemapplicatie" Then
       Sheets("UMG").Select
       ActiveWorkbook.Names("keuze5").Delete
       ActiveWorkbook.Names.Add Name:="keuze5", RefersToR1C1:="=UMG!R2C54:R5C54"
       Sheets("UMG").Select
    End If
End If
End If
End If


If Not Application.Intersect(Target, Range("G10:G100")) Is Nothing Then

  If Target.Value = "ANVA" Then
    With Sheets("UMG")
      For r = 1 To 15
        .Cells(r, 61).Value = ""
      Next
      .Cells(1, 61).Value = .Cells(1, 60).Value
      .Cells(2, 61).Value = .Cells(2, 60).Value
      .Cells(3, 61).Value = .Cells(6, 60).Value
      Set myRange = Union(.Cells(1, 61), .Cells(2, 61), .Cells(3, 61))
    End With
    ActiveWorkbook.Names("keuze6").Delete
    ActiveWorkbook.Names.Add Name:="keuze6", RefersToR1C1:=myRange
    Sheets("UMG").Select
    Set myRange = Nothing
  End If

  If Target.Value = "VPN" Then
    With Sheets("UMG")
      For r = 1 To 15
        .Cells(r, 61).Value = ""
      Next
      .Cells(1, 61).Value = .Cells(1, 60).Value
      .Cells(2, 61).Value = .Cells(2, 60).Value
      .Cells(3, 61).Value = .Cells(10, 60).Value
      .Cells(4, 61).Value = .Cells(12, 60).Value
      Set myRange = Union(.Cells(1, 61), .Cells(2, 61), .Cells(3, 61), .Cells(4, 61))
    End With
    ActiveWorkbook.Names("keuze6").Delete
    ActiveWorkbook.Names.Add Name:="keuze6", RefersToR1C1:=myRange
    Sheets("UMG").Select
    Set myRange = Nothing
  End If
End If

End Sub
 
Ik neem aan dat je mijn code terug in je eigen sheet hebt geplakt?

In principe moet mijn code geen interferentie geven met het stukje voor de kolommen F en verder. Heb je gekeken of de triggers waar je op reageert nog correct zijn?
 
Ja heb ik geplakt, volgens mij zit de fout hem in het stukje:

Dim myRange As Range
Dim r As Integer

En dat is bij jou nu:

Dim myRange As String
 
In dat geval zou ik in mijn stukje met CTRL-H mijn 'myRange' vervangen door 'myRange2' of een andere variabele naam. Vervolgens pas in je andere code plakken. je kunt het ook myString noemen natuurlijk :P .
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan