Keresés

Új hozzászólás Aktív témák

  • Fferi50

    őstag

    válasz EmberXY #32626 üzenetére

    Szia!

    Némi munkával és egy kis makróval megoldható a dolog.
    A makró futásához elég sok előkészület kell, de szerintem megéri.
    1. lépés: Ha nem kimutatások vannak a lapon, akkor minden "táblázatot" célszerű átalakítani Táblázattá a beszúrás táblázat menüpontban, a nevüket használjuk majd. Ha csak kimutatások vannak, akkor azok neve használható. Ha nem szeretnéd táblázat formában használni, akkor is minden részterületnek adj nevet légy szíves. Mindhárom esetet nevezzük most táblának.
    2. lépés: Kinevezel egy cellát, amelyben a kiválasztott tábla nevét fogjuk megadni. Ezt természetesen elrejtheted, lényeg, hogy a használandó területen kívül legyen. Ez nálam az AQ68 cella volt.
    3. lépés: Minden táblára egyenként feltételes formázást csinálsz az alábbiak szerint:
    A formázandó cellák kijelölése képlettel, A képlet pedig:
    =$A$68="Táblanév" formátumnak kijelölöd amit szeretnél látni pl. kitöltés zöld, érvényesség =Táblanév
    Ha táblázattá alakítottad, vagy kimutatás, akkor a bővítésnél automatikusan bővül a terület.
    4. lépés: A munkalap kódlapjára bemásolod az alábbi makrót (lapfül - jobb egérgomb - kód megjelenítése)
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    dim tbl as Variant
    Application.EnableEvents = False
    Range("AQ68").Value = 0' ide annak a cellának a címét írod, ahová a feltételes formázás jelzőjét tetted
    On Error Resume Next
    For Each tbl In ActiveSheet.ListObjects ' ha kimutatások vannak akkor Pivottables
    If Not Intersect(Target, Range(tbl)) Is Nothing Then
    If Err = 0 Then Range("AQ68") = tbl.Name: Exit For
    Err = 0
    End If
    Next
    Application.EnableEvents = True
    End Sub

    Ha van kimutatás és általad átalakított táblázat is, akkor két ciklus kell egymás után, egy a ListObjects, egy másik pedig a Pivottables objektumokra. Ha még neveid is vannak(nem alakítottad táblázattá a tartományt, csak névvel láttad el, akkor az is külön ciklus és ott a névvel variálni kell, nem lesz jó rá a fenti sor).

    Ha több munkalapodon is van hasonlóra szükség, akkor a névadást és a formázást minden lapon el kell végezned, a makrót viszont akkor a Thisworkbook kódlapjára kell beírni a következő két sor közé:
    Alt+F11 - VBA projectet kibontod, ott a Thisworkbook -ra dupla katt - bal oldali lenyílóból Workbook - jobb oldali lenyílóból SheetSelectionChange, megjelenik az alábbi két sor.
    Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    End Sub

    A makró és a megelőző munkád eredménye:
    A hivatkozásra kattintva a megfelelő tábla átszíneződik a feltételes formázásnak megfelelően (ezért egy színűre, de akár különböző színűre is formázhatod a táblákat), ha a táblán belül kattint, vagy másik cellára lép, marad a formázás. Ha másik táblára kattint, akkor a másik tábla formázódik át, az előző formázása megszűnik. Ha táblán kívülre kattint, akkor megszűnik a formázás. Értelemszerűen akkor is megszűnik a formázás, ha visszaugrik a hivatkozás oszlopokra.

    Ezután nincs más hátra, mint makróbarát munkafüzetként elmenteni az egészet - kipróbálni és remélhetőleg örülni.

    Remélem, sikerül megoldani. Ha bármi gondod lenne, csak írj lsz.

    Üdv.

    [ Szerkesztve ]

Új hozzászólás Aktív témák