Range aanpassen

gpiket7 · 18 aug 2010

Ik heb een VBA code met het volgende stuk script:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
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!R2C28:R8C28"
Sheets("UMG").Select

Nu laat hij als het landelijk is de regels 2 t/m 8 zien uit kolom 28
Hoe kan ik dit aanpassen naar bijvoorbeeld alleen de regels 2,4,5 en 8?

RoCompy87 · 18 aug 2010

Neem eens een macro op waarbij je een nieuwe naam bepaalt die verwijst naar AB2, AB4, AB5 en AB8. Dan heb je het meteen in de juiste VBA-code staan

Hoornvan · 18 aug 2010

gpiket7,

Kijk eens of dit zo werkt.

Code:

ActiveWorkbook.Names.Add Name:="keuze2", RefersToR1C1:="=UMG!R2C28,R4C28:R5C28,R8C28"

gpiket7 · 19 aug 2010

Hoornvan,

Dan krijg ik alleen de keuze uit cel 2 en niet de andere keuzes...

-----

RoCompy87,

Als ik een Macro opneem zet hij het er in als (AB2, AB4, AB5, AB8)
En als ik dat in mijn stuk script plaats werkt dat niet...

MDN111 · 19 aug 2010

Hallo !

Probeer eens het volgende:

Code:

Sub test()
Dim myRange As Range
With Sheets("UMG")
  Set myRange = Union(.Cells(2, 28), .Cells(4, 28), .Cells(5, 28), .Cells(8, 28))
End With
ActiveWorkbook.Names.Add Name:="keuze2", RefersToR1C1:=myRange
Sheets("UMG").Select
End Sub

Grtz,
MDN111

gpiket7 · 20 aug 2010

Beste MDN111,

Heb het geprobeerd, maar krijg het met jou code niet voor elkaar.
Ik mis in jou stukje ook het stuk: if target.value = "landelijk"

RoCompy87 · 20 aug 2010

Gebaseerd op jouw oorspronkelijke code, werkt onderstaande wellicht?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
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!R2C28,UMG!R4C28,UMG!R5C28,UMG!R8C28"
        Sheets("UMG").Select
    End If
End If
End Sub

gpiket7 · 20 aug 2010

Beste RoCompy87,

Dan laat ie alleen de uitkomst van rij 2 zien.

Warme bakkertje · 21 aug 2010

Alle voorgestelde codes selecteren toch de door jou gewenste cellen als ik in het naamvak keuze2 kies :shocked:
Zie je eigen antwoord in Post#4

MDN111 · 23 aug 2010

Hallo !

Hierna vind je de oorspronkelijke code uit de post van 18/08/2010 aangepast met de code uit m'n post van 19/08/2010. Deze laatste had ik getest en die werkte wel degelijk.

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim myRange As Range
If Not Application.Intersect(Target, Range("C10:C100")) Is Nothing Then
  If Target.Value = "Landelijk" Then
    With Sheets("UMG")
      Set myRange = Union(.Cells(2, 28), .Cells(4, 28), .Cells(5, 28), .Cells(8, 28))
    End With
    ActiveWorkbook.Names("keuze2").Delete
    ActiveWorkbook.Names.Add Name:="keuze2", RefersToR1C1:=myRange
  Sheets("UMG").Select
  End If
End Sub

Grtz,
MDN111.

gpiket7 · 23 aug 2010

Het wilt dus niet vlotten, hierbij het stuk script waat het bij geplaatst moet worden:

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
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!R2C28:R4C28"
        Sheets("UMG").Select
    Else
    If Target.Value = "Regio" Then
       Sheets("UMG").Select
       ActiveWorkbook.Names("keuze2").Delete
       ActiveWorkbook.Names.Add Name:="keuze2", RefersToR1C1:="=UMG!R2C29:R6C29"
       Sheets("UMG").Select
    Else
    If Target.Value = "SBC" Then
        Sheets("UMG").Select
        ActiveWorkbook.Names("keuze2").Delete
        ActiveWorkbook.Names.Add Name:="keuze2", RefersToR1C1:="=UMG!R2C30:R2C30"
        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!R2C36:R3C36"
        Sheets("UMG").Select
    Else
    If Target.Value = "Meeùs" Then
        Sheets("UMG").Select
        ActiveWorkbook.Names("keuze3").Delete
        ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R5C36:R5C36"
        Sheets("UMG").Select
    Else
    If Target.Value = "Unirobe" Then
        Sheets("UMG").Select
        ActiveWorkbook.Names("keuze3").Delete
        ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R6C36:R6C36"
        Sheets("UMG").Select
    Else
        If Target.Value = "Landelijk" Then
        Sheets("UMG").Select
        ActiveWorkbook.Names("keuze3").Delete
        ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R4C36:R4C36"
        Sheets("UMG").Select
    Else
    If Target.Value = "Zuid West" Then
       Sheets("UMG").Select
       ActiveWorkbook.Names("keuze3").Delete
       ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C37:R14C37"
       Sheets("UMG").Select
    Else
    If Target.Value = "Zuid Oost" Then
       Sheets("UMG").Select
       ActiveWorkbook.Names("keuze3").Delete
       ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C38:R15C38"
       Sheets("UMG").Select
    Else
    If Target.Value = "West" Then
       Sheets("UMG").Select
       ActiveWorkbook.Names("keuze3").Delete
       ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C39:R12C39"
       Sheets("UMG").Select
    Else
    If Target.Value = "Noord Oost" Then
       Sheets("UMG").Select
       ActiveWorkbook.Names("keuze3").Delete
       ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C40:R17C40"
       Sheets("UMG").Select
    End If
    If Target.Value = "LVO" Then
       Sheets("UMG").Select
       ActiveWorkbook.Names("keuze3").Delete
       ActiveWorkbook.Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C41:R4C41"
       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
End Sub

Het gaat dan om de cellen G10:G100 en keuze6

Met het stuk script:

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim myRange As Range
If Not Application.Intersect(Target, Range("G10:G100")) Is Nothing Then
  If Target.Value = "ADP" Then
    With Sheets("UMG")
      Set myRange = Union(.Cells(2, 60), .Cells(4, 60), .Cells(5, 60), .Cells(8, 60))
    End With
    ActiveWorkbook.Names("keuze6").Delete
    ActiveWorkbook.Names.Add Name:="keuze6", RefersToR1C1:=myRange
  Sheets("UMG").Select
  End If
End Sub

Krijg ik alleen als keuze de invoer uit cel2.

keuze6 - kolom 60 en dan cel 1 t/m 12

Ik hoop dat het zo duidelijker wordt... Dacht dat ik het wel tussengevoegd kreeg, maar dat lukt dus niet...

MDN111 · 23 aug 2010

Hallo gpiket7 !

Het wil inderdaad niet vlotten, maar dat komt omdat de opdracht niet duidelijk is. In de eerste post spreek je over keuze2 en het probleem was dat keuze2 verwees naar aaneengesloten cellen vanaf rij 2 t/m rij 8 van de 28ste kolom in plaats van naar afzonderlijke cellen van de 28ste kolom. De code in m'n post van 19/08/2010 heb ik getest en die werkte.

Nu spreekt u over keuze6 en vermeldt u ook "cel 2".

Is het mogelijk om een, eventueel vereenvoudige, bijlage toe te voegen zonder vertrouwelijke gegevens en tevens de "uitdaging" concreet de beschrijven?

Grtz,
MDN111

PS. Kan slechts vanaf volgende donderdag weer antwoorden.

gpiket7 · 23 aug 2010

Je moet kijken naar de kolommen F, G en H
Als je in F een keuze maakt krijg je verschillende keuze mogelijkheden in G
Nu wil ik naar aanleiding wat je kiest in G ook verschillende mogelijkheden krijgen in kolom H.
Deze mogelijkheden staan in kolom 60 (BH) onder elkaar.

Maar als er in G dus gekozen wordt voor Office moet in H bijvoorbeel de keuzes Backoffice administratie en Ontroerend goed administratie verschijnen. Maar als in G iets anders gekozen wordt veranderen de keuzes in H.

Maar omdat deze onder elkaar staan krijg ik het niet voor mekaar...

Ik hoop dat het zo duidelijk is!

Warme bakkertje · 23 aug 2010

Zo wordt je macro al leesbaarder

Code:

Private Sub Worksheet_Change1(ByVal Target As Excel.Range)
With ActiveWorkbook
If Not Intersect(Target, Range("C10:C100")) Is Nothing Then
    Select Case Target.Value
        Case "Landelijk"
            .Names("keuze2").Delete
            .Names.Add Name:="keuze2", RefersToR1C1:="=UMG!R2C28:R4C28"
        Case "Regio"
            .Names("keuze2").Delete
            .Names.Add Name:="keuze2", RefersToR1C1:="=UMG!R2C29:R6C29"
        Case "SBC"
            .Names("keuze2").Delete
            .Names.Add Name:="keuze2", RefersToR1C1:="=UMG!R2C30:R2C30"
    End Select
End If
If Not Intersect(Target, Range("D10:D100")) Is Nothing Then
    Select Case Target.Value
        Case "Alle Regio's"
            .Names("keuze3").Delete
            .Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C36:R3C36"
        Case "Meeùs"
            .Names("keuze3").Delete
            .Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R5C36:R5C36"
        Case "Unirobe"
            .Names("keuze3").Delete
            .Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R6C36:R6C36"
        Case "Landelijk"
            .Names("keuze3").Delete
            .Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R4C36:R4C36"
        Case "Zuid West"
            .Names("keuze3").Delete
            .Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C37:R14C37"
        Case "Zuid Oost"
            .Names("keuze3").Delete
            .Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C38:R15C38"
       Case "West"
            .Names("keuze3").Delete
            .Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C39:R12C39"
        Case "Noord Oost"
            .Names("keuze3").Delete
            .Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C40:R17C40"
        Case "LVO"
            .Names("keuze3").Delete
            .Names.Add Name:="keuze3", RefersToR1C1:="=UMG!R2C41:R4C41"
    End Select
End If
If Not Intersect(Target, Range("F10:F100")) Is Nothing Then
    Select Case Target.Value
        Case "Bedrijfsapplicatie"
            .Names("keuze5").Delete
            .Names.Add Name:="keuze5", RefersToR1C1:="=UMG!R2C52:R28C52"
        Case "Afhankelijkheden"
            .Names("keuze5").Delete
            .Names.Add Name:="keuze5", RefersToR1C1:="=UMG!R2C51:R10C51"
        Case "Kantoorapplicatie"
            .Names("keuze5").Delete
            .Names.Add Name:="keuze5", RefersToR1C1:="=UMG!R2C53:R4C53"
        Case "Systeemapplicatie"
            .Names("keuze5").Delete
            .Names.Add Name:="keuze5", RefersToR1C1:="=UMG!R2C54:R5C54"
    End Select
End If
End With
End Sub

MDN111 · 26 aug 2010

Hallo gpiket7 !

De invoermogelijkheden voor kolom F en de daarbij horende mogelijkheden voor kolom G zijn duidelijk. Daarvoor hebt u een 2-dimensioneel rooster opgesteld in de kolommen 51 t/m 54. Als je nu ook keuzemogelijkheden wil geven voor kolom H, in functie van de invoerwaarde in kolom G, dan heb je in feite een 3-dimensioneel probleem. Dat is oplosbaar, maar het nadeel is dat je veel "hard coded" moet werken. Stel je voor dat er ergens een keuzemogelijkheid bijkomt. Dan moet je in de macro de juiste celverwijzingen aanpassen en als het dan drie maanden geleden is dat je je macro nog hebt bekenen, is het zoeken geblazen... Persoonlijk zou ik opteren voor een aparte sheet met drie kolommen: "Categorie", Applicatie / Afhankelijkheid" en "Dienst" en in die kolommen alle mogelijke toegelaten invoercombinatiescombinaties invoeren.

Maar goed, wie ben ik? We gaan verder op de weg die jij bent ingeslagen... Het eerste probleem was het samenvoegen van de gepaste cellen uit kolom 60. Die cellen hangen af van de ingevoerde waarde in kolom G en die cellen liggen niet aaneengesloten! Dat is de kern van het probleem. In gpiket7.xls vind je de aangepaste code met de keuzemogelijkheden uit je post van 23/08/2010 en aangevuld met een eigen verzonnen combinatie. De variabele myRange bevat telkens de gepaste, niet aaneengesloten, cellen uit kolom 60 en als je de range "keuze6" selecteert zul je zien dat de gepaste cellen geselecteerd zijn. Maar...

De data validation werkt alleen met aaneengesloten cellen! In gpiket7A.xls vind je een workaround. Daarvoor gebruiken we kolom 61 waarin we de waarde uit de gepaste cellen van kolom 60 kopiëren en dan verwijst keuze6 naar de cellen uit kolom 61, die nu wel aaneengesloten liggen. Het werkt en ik vermoed dat je op deze basis wel verder kan.

Tenslotte nog een bedenking. In plaats van de verwijzing van de verschillende named ranges te wijzigen met een macro, is het toch mogelijk de data validation zonder omwegen in te stellen via de macro?, zoals bijvoorbeeld:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
'
'
'
If Target.Value = "Kantoorapplicatie" Then
  With Sheets("UMG").Range("G10:G100").Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
      Operator:=xlBetween, _
        Formula1:="Adobe,Offerte,Office"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
    End With
End If
'
'
'
End Sub

Grtz,
MDN111.

gpiket7 · 26 aug 2010

Geniaal, ik ga voor de oplossing in gpiket7A. Deze doet precies wat ik wil

Ik ben alleen benieuwd met de manier hoe jij het zou doen dan?
Want ik begreep dat alles op dezelfde sheet moet staan om die keuze menu's te krijgen?!

MDN111 · 7 sep 2010

Hallo gpiket7 !

Nog even een late reactie. We hebben erg ons best gedaan om Data Validation dymamisch in te stellen aan de hand van macro's, maar bij toeval kwam ik op een Excel Tip die verduidelijkt hoe dat zelfs zonder macro's kan:

http://excel.tips.net/Pages/T002972_Creating_Dependent_DropLists.html?awt_l=FShKR&awt_m=1bTLaqWDicQF4X

Grtz,
MDN111.

Range aanpassen

gpiket7

Gebruiker

RoCompy87

Gebruiker

Hoornvan

Terugkerende gebruiker

gpiket7

Gebruiker

MDN111

Gebruiker

gpiket7

Gebruiker

RoCompy87

Gebruiker

gpiket7

Gebruiker

Warme bakkertje

Meubilair

MDN111

Gebruiker

gpiket7

Gebruiker

MDN111

Gebruiker

gpiket7

Gebruiker

Bijlagen

Warme bakkertje

Meubilair

MDN111

Gebruiker

Bijlagen

gpiket7

Gebruiker

MDN111

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy