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

• #27727 Mutt senior tag csongi #27684

  Új Válasz 2015-07-13 10:01:37 #27727

  Ú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

  

  Mutt

  senior tag

  válasz csongi #27684 üzenetére

  Hello,

  ...egy adott cellába, legyen egy képlet, de ha kézzel beleírok akkor a beírt érték legyen, viszont ne vesszen el a képlet sem....

  Van egy kevésbé használt függvény az S (angolul N), ami ha szöveget kap értéknek, akkor nem számol vele.
  pl. =N("komment") értéke 0 és ezek után =2+N("komment") cella értéke is 2 lesz.

  Ez a függvény jön itt nekünk segítségre, mivel a cella képletét ebbe a függvénybe elrejtjük.

  A lenti makróval első lépésként megjegyezzük a cella tartalmát és képletét ha van a Worksheet_SelectionChange eseménnyel. Az egyszerűség kedvéért csak akkor tesszük, ha egyszerre 1 cella van módosítva.

  A második lépésben ha a változik vmi a lapon, akkor a Worksheet_Change esemény lép akcióba és attól függően, hogy volt-e képlet vagy sem, esetleg töröltük a cella bedobja ami kell éppen.

  A kód nem tökéletes, iránymutatásnak szántam.

  Option Explicit
  Dim KepletVanBenne As Boolean
  Dim Tartalom As String
  
  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
  KepletVanBenne = False
  Tartalom = ""
  
  If Target.Cells.Count = 1 Then 'egyszerűség kedvéért csak 1 cellára dolgozunk
  KepletVanBenne = Target.HasFormula 'megnézzük hogy van-e képlet a cellában
  If KepletVanBenne Then Tartalom = Target.FormulaLocal 'elmentjük a képletet egy változóba
  End If
  
  End Sub
  
  Private Sub Worksheet_Change(ByVal Target As Range)
  Dim EredetiKeplet
  Dim Keresni As String
  
  'Excel nyelvének megállapítása
  If Application.LanguageSettings.LanguageID(msoLanguageIDUI) = 1038 Then
  Keresni = "+S("
  Else
  Keresni = "+N("
  End If
  
  If Target.Cells.Count = 1 Then 'egyszerűség kedvéért csak 1 cellára dolgozunk
  'ha az új cella konstans akkor mögétesszük a képletet, ha volt korábban
  If Not Target.HasFormula Then
  'megnézzük hogy a korábban volt-e képlet a cellában, ha igen akkor kinyerjük az eredeti képletet onnan
  EredetiKeplet = Split(Tartalom, Keresni) 'bízunk benne, hogy nincs a cellában +N( kifejezés más indok miatt
  If IsArray(EredetiKeplet) And UBound(EredetiKeplet) > 0 Then
  'itt kicsit formázni kell mivel vmi ilyet kapunk vissza "=A1"), de nekünk csak =A1 kell
  Tartalom = Mid(EredetiKeplet(1), 2, Len(EredetiKeplet(1)) - 3)
  End If
  
  'ha törlik a cella tartalmát, akkor berakuk az eredeti képletet
  If Target.Value = "" Then
  Target.FormulaLocal = Tartalom
  Else
  Target.Formula = "=" & Target.Value & "+N(""" & Tartalom & """)" 'az új cellatartalom az lesz, hogy bevitt érték + korábbi formula
  End If
  End If
  End If
  
  End Sub

  üdv.

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