Gegevensvalidatie zonder melding middels vba

Status
Niet open voor verdere reacties.
B

Bergsma1

Gebruiker
Lid geworden
7 feb 2012
Berichten
40
Ik zoek een script waarmee ik het volgende afdwing.
Het script moet worden geactiveerd bij iedere wijziging (als een vorm van gegevensvalidatie) in cell A1 en C2.

Het betreft geen waarden/text

Als een waarde/text in cel A1 wordt ingegeven, zoek de waarde van cel A1, in tabblad Zoek, Range A:A
Als deze waarde/text wordt gevonden, activeer cel C2
Als deze waarde/text niet wordt gevonden, maak cel A1 leeg en selecteer cel A1 opnieuw

Als een waarde/text in cel C2 wordt ingegeven, zoek de waarde van cel C2, in tabblad Zoek, Range D:D
Als deze waarde/text wordt gevonden, ga naar cel D4
Als deze waarde/text niet wordt gevonden, maak cell C2 leeg en selecteer cell C2 opnieuw
 
Wat staat er dan wel in tabblad zoek, kolom A ?
 
Een lijst met zaken die je mag invoeren op A1, staat het niet in de lijst, mag je deze niet invoeren
Hetzelfde geldt voor kolom D, deze dient als restrictielijst voor de invoer op C2
 
Als het geen waarden/tekst betreft wat staat er dan? Plaats een voorbeeldbestand.
 
een aanzet (wat omslachtig als het bij 2 cellen blijft , maar bij uitbreiding wellicht wat makkelijker aan te passen)

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

Const eindCel As String = "F10"
Const validateRng As String = "A1,C2,D4" 'ervan uitgaande dat er meerdere cellen zonder vaste offset volgen
Const kolom As String = "1,4,5" 'nummers van de kolommen waar gezocht moet worden in dezelfde volgorde als hierboven
Const ZoekSheet As String = "Zoek" 'naam van de sheet waar gezocht moet worden

Dim x As Variant, y As Long 'deze wel declareren anders Clng gebruiken

With Application
    If Intersect(Target, Range(validateRng)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    x = Split("," & validateRng & "," & eindCel & ",", Target.Address(False, False) & ",")
    y = Split(kolom, ",")(UBound(Split(x(0), ",")) - 1)
        If .CountIf(Sheets(ZoekSheet).Columns(y), Target.Value2) > 0 Then
            Range(Left(x(1), InStr(x(1), ",") - 1)).Select
        Else
            .EnableEvents = False
            Target.Value2 = ""
            Target.Select
            .EnableEvents = True
        End If
End With
End Sub

tbv jouw vraag volstaat:
Const eindCel As String = "D4"
Const validateRng As String = "A1,C2"
Const kolom As String = "1,4"
 
Super bedankt Eric, het script is zo eenvoudig configureerbaar, en ik gebruik kolom E als referentielijst voor cel d4!
Ik snap niet helemaal wat er in dit script gebeurt, maar het werkt zoals gewenst en ik heb het e.e.a. al verder kunnen aanpassen :cool:
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan