Érdekes Excel-fejtörővel örvendeztetett meg egyik kedves Olvasóm, aki egy nagyon egyszerű Data Validation List kérdésre kereste a választ. Tegyük fel, hogy van két sheetünk (Lista és Termékcsoport), az egyiken van egy egyszerű legördülő menünk, amelynek elemei a másik sheeten szereplő listából kerülnek beolvasásra. Valahogy így:

Eddig ez nagyon egyszerű történet, de mi van ha ennél jóval több legördülő menünk van, amelyekre aztán kész hivatkozáserdőt építünk fel és közben változtatunk valamit a validációs listán? Az eredetileg kiválasztott értékek maguktól nem fognak frissülni, újra választani kellene őket a legördülő menükből. Az aktuális példánál mondjuk kiválasztottuk a Termék5 nevű terméket a legördülő menüből, de később a forráslistában Termék5 nevét lecseréltük valami másra, akkor magától ez nem fog átíródni, újra ki kell választani az új névre hallgató terméket. A kérdés tehát az, hogy ezt hogy tudjuk elkerülni.

Egy rövidke VBA-kódra van ehhez szükségünk, amelyet a forráslistánkat tartalmazó sheetre építünk be azzal a logikával, hogy ha azon a sheeten bármi változik, akkor a másikon frissít a változásnak megfelelően.

De kezdjük az elején, menjünk át ALT+F11 lenyomásával a VBA-editorba, ahol a második sheetünkre, jelen esetben a Termékcsoport munkalapunkra a Worksheet Change eseményhez rendeljük hozzá kódunkat.

A ByVal Target As Range jelen esetünkben azt jelenti, a tartományunk cellájának változása indítja el az eseményt. Változók definiálásával folytatjuk a kódunkat, deklarálunk egy változót Integer típussal az érintett celláink számának ("cellaszam"), egy-egy változót a régi és az új cellatartalomnak String típussal ("uj" és "regi") valamint egyet Range típussal a legördülő menüt tartalmazó sheetünkre, a konkrét menüt tartalmazó cellára ("rng").

Nagyjából amit most majd tenni fogunk az az, hogy egy For...Next utasítás segítségével a validation listünket tartalmazó sheeten az összes listaelemünkön végig fogunk menni és ha közöttük találunk olyat, ami nincs a legördülő menüt tartalmazó sheeten, akkor cserét hajt végre.

Tehát kezdjük azzal, hogy a listaelemeket tartalmazó sheetünkön az első értéket tartalmazó cellától indulva megszámoljuk, hogy hány sorunk, azaz elemünk van, tehát a ciklust hányszor fogjuk végrehajtani:

For cellaszam = 1 To Range("A1").CurrentRegion.Rows.Count

A fentebb deklarált rng változóra beállítjuk a konkrét legördülő menüt tartalmazó cellánkat a másik sheetről:

Set rng = Worksheets("Lista").Range("A3")

Aztán most következik kódunk motorja, egy Intersect metódus, ami egy olyan tartományt fog visszaadni, ami két vagy több másik tartomány metszete. Arra is használhatjuk többek között, hogy meghatározzuk, egy bizonyos tartomány és egy másik tartomány között van-e átfedés.

Jelen esetben megnézzük, hogy a fentebb deklarált rng tartomány és a listaelemeket tartalmaz tartomány meghatározott/megváltozott eleme között van-e átfedés, ha van, tehát megegyezik a legördülő menünkből kiválasztott listaelem az adott elemmel a listaelemeket tartalmazó sheeten, akkor ne csináljon semmit, ha nem, akkor jön a változtatás.

If Intersect(Target, Range("A" & cellaszam)) Is Nothing Then

Most jön a kódunk azon része, hogy mi történjen, ha nincs egyezés, tehát változott valami a listaelemek között és ennek tükröződnie kellene a legördülő listából már kiválasztott elemben is.

Itt fontos egy Application.EnableEvents = False utasítás, hogy a most következő változtatásunk ne váltson ki egy újabb Worksheet_Change eseményt, ami a makró újbóli lefutását eredményezné majd megint és megint és így tovább.

Ezután az uj változó vegye fel a megváltozott listaelem értékét.

Application.Undo utasítással a megváltoztatott listaelemünk értékét írjuk vissza eredeti értékére és ezt töltsük be a regi változóba. Ezután írjuk vissza megint a listaelemünk értékét az új értékre.

Már csak egy dolog van hátra, azaz updatelnünk kell azt a legördülő menüt tartalmazó cellát, ahol olyan értékünk szerepel, ami már nincs is a listában.

És ezzel kész is vagyunk, ugorhatunk a ciklusban egyet, majd ne felejtsük el a ciklus befejeződése után visszakapcsolni Application.EnableEvents = True utasítással a Worksheet változásra való reagálását.

Másolható szövegként:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellaszam As Integer
Dim uj As String
Dim regi As String
Dim rng As Range
For cellaszam = 1 To Range("A1").CurrentRegion.Rows.Count
Set rng = Worksheets("Lista").Range("A3")
If Intersect(Target, Range("A" & cellaszam)) Is Nothing Then
Else
Application.EnableEvents = False
uj = Target.Value
Application.Undo
regi = Target.Value
Target.Value = uj
rng.Replace What:=regi, Replacement:=uj
Target.Select
End If
Next cellaszam
Application.EnableEvents = True
End Sub