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

• #32627 Fferi50 Topikgazda EmberXY #32626

  Új Válasz 2016-09-09 23:09:44 #32627

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Fferi50

  Topikgazda

  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.

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