Pitempi alasvetovalikko

Anonyymi

Olen tehnyt Tietojen kelpoisuuden tarkastaminen -työkalulla taulukkooni valikon n. 50:lle nimelle.
Avatessani taulukosta alasvetovalikon en näe yhdelläkertaa kaikkia nimiä valikossa, vaan vain ehkä 10-15 nimeä ja nimien vieressä oikealla ns. hissi, jota siirtämällä saan lisää nimiä näkyviin.
Kysymys kuuluu: Miten saan koko nimivalikon ilman hissiä näkyviin ja onko se edes mahdollista?

62

106

Vastaukset

  • Tietotojen kelpoisuustarkistus listan kokoa ei voi muuttaa. Katsoppas tuosta linkistä youtube video jossa esitetään vaihtoehtoinen tapa (Yhdistelmäruutu). Sen kokoa voi muuttaa, mutta se ei anna haluttuun soluun suoraan vastausta vaan antaa numeron joka vastaa valitsemaasi arvoa ja sitten INDEKSI-kaavalla haetaan se haluttu arvo oikeaan soluun.
    Selaa sivua alaspäin kunnes tulee oAnastin vastaus josta löytyy tuo video
    https://answers.microsoft.com/en-us/msoffice/forum/all/excel-2010-data-validation-is-there-a-way-to/3afdc062-5efe-41f8-b094-e77464efae50

    • Jotenkin muistelinkin, ettei listan kokoa voi muuttaa. Kiitos videolinkistä, ratkaisu ei oikein mulle auennut, eikä näyttänyt ainakaan kätevältä -jos edes liittyikään Tietotojen kelpoisuus tarkistukseen.

      -aloittaja


  • Laitoin linkkiin kuvan miten tuo Yhdistelmäruutu toimii. Sen saa "pelaamaan" aivan samaten kuin Kelpoisuustarkistus.
    https://aijaa.com/hNjnE1

    • https://aijaa.com/hNjnE1.. en ihan saanut kiinni tuosta! Kiitos silti. Odotan, jos saisin Kunden ehdotuksesta (VB:stä) jotain irti. :))
      -aloittaja


  • hiiren oikeaan valikkoon kelpoisuusehto

    moduuliin...
    Sub TeeValikko()
    Dim ctrl As CommandBarControl
    Dim btn As CommandBarControl
    Dim i As Long
    Dim Vika As Long
    PoistaMenu
    Set ctrl = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=1)
    'muuta otsikko sopivaksi
    ctrl.Caption = "Kelpoisuusehdot..."
    Vika = Range("H65536").End(xlUp).Row
    i = 1
    'kelpoisuusehto alue , muuta sopivaksi
    For Each solu In Range("H1:H" & Vika)
    Set btn = ctrl.Controls.Add
    btn.Caption = solu
    btn.Tag = i
    btn.OnAction = "LisääKelpoisuusehto"
    i = i + 1
    Next
    End Sub

    Private Sub LisääKelpoisuusehto()
    ActiveCell = Application.CommandBars.ActionControl.Caption
    End Sub
    'poistaa tiedot hiiren okeasta valikosta
    Sub PoistaMenu()
    Dim ctrl As CommandBarControl
    For Each ctrl In Application.CommandBars("Cell").Controls
    If ctrl.Caption = "Lisää tekstit..." Then ctrl.Delete
    Next
    End Sub

    Keep EXCEling
    @Kunde

    • Kaiken roskan keskellä on aina ilo lukea ketjuja/viestejä missä on asiat kohdillaan. Kiitokset asiantuntijoille!


    • Kunde, avaatko hieman tuota koodisi toimintaa. Kuvittelisin osaavani laittaa tuon VB-koodin oikeaan paikkaan, mutta mitä toimia oma viilaaminen edellyttää?
      Tämänhetkinen varsinainen nimilista on alueella B49-63, josta olen tehnyt tuon kelpoisuusnuolivalikon. Nythän tilanne on se, että nuolivalikosta saan näkyviin vain 8 nimeä, loput 7 nimeä joutuu vierittämään. Nimilista voi tästä pidenyäkin.

      -aloittaja


    • Anonyymi kirjoitti:

      Kunde, avaatko hieman tuota koodisi toimintaa. Kuvittelisin osaavani laittaa tuon VB-koodin oikeaan paikkaan, mutta mitä toimia oma viilaaminen edellyttää?
      Tämänhetkinen varsinainen nimilista on alueella B49-63, josta olen tehnyt tuon kelpoisuusnuolivalikon. Nythän tilanne on se, että nuolivalikosta saan näkyviin vain 8 nimeä, loput 7 nimeä joutuu vierittämään. Nimilista voi tästä pidenyäkin.

      -aloittaja

      Kunde, kokeilin arpomalla tuota VB-koodiasi vaihtelevalla menestyksellä.
      Osittain sain tuon jopa toimimaan, mutta jotenkin vajaana. Kokeilin vaihtaa koodiin eri mittaisia valikkopituuksia, kuten kohtaan: ("H1:H" & Vika) tilalle: B49:B70 ja ("H65536") -tilalle: ("B50"). Sain kummallisia ilmiöitä.

      Lopetin kokeilemisen, kun en päässyt juuri pidemmälle.
      Mutta.. ei tässä vielä kaikki, kaiken kokeilun jälkeen jäljelle jäi kummallinen ilmiö: eräänlainen haamuvalikko! Tällä tarkoitan sitä, että kun avaan esim. täysin uuden Excel -työkirjan ja klikkaan hiiren oikealla (hiiren kakkosella) satunnaisen solun pällä -on avautuneen apuvalikon yläreunaan ilmestynyt pitkä lista (15 kpl) VB-koodistasi pätkä, eli: "Kelpoisuusehdot..." eli allekkain on 15 kpl noita "Kelpoisuusehdot..." -koodinpätkäsanoja.
      Olen koittanut vaikka mitä kikkoja noiden poistamiseen, mutta selvästikin joku keino on kokeilematta. Mikä ja mistä nuo edes ovat jääneet tuonne roikkumaan, vaikka en enää työstä tuota ko. taulukkoa?

      -aloittaja


    • Anonyymi kirjoitti:

      Kunde, kokeilin arpomalla tuota VB-koodiasi vaihtelevalla menestyksellä.
      Osittain sain tuon jopa toimimaan, mutta jotenkin vajaana. Kokeilin vaihtaa koodiin eri mittaisia valikkopituuksia, kuten kohtaan: ("H1:H" & Vika) tilalle: B49:B70 ja ("H65536") -tilalle: ("B50"). Sain kummallisia ilmiöitä.

      Lopetin kokeilemisen, kun en päässyt juuri pidemmälle.
      Mutta.. ei tässä vielä kaikki, kaiken kokeilun jälkeen jäljelle jäi kummallinen ilmiö: eräänlainen haamuvalikko! Tällä tarkoitan sitä, että kun avaan esim. täysin uuden Excel -työkirjan ja klikkaan hiiren oikealla (hiiren kakkosella) satunnaisen solun pällä -on avautuneen apuvalikon yläreunaan ilmestynyt pitkä lista (15 kpl) VB-koodistasi pätkä, eli: "Kelpoisuusehdot..." eli allekkain on 15 kpl noita "Kelpoisuusehdot..." -koodinpätkäsanoja.
      Olen koittanut vaikka mitä kikkoja noiden poistamiseen, mutta selvästikin joku keino on kokeilematta. Mikä ja mistä nuo edes ovat jääneet tuonne roikkumaan, vaikka en enää työstä tuota ko. taulukkoa?

      -aloittaja

      ko taulukon moduulin ...
      nyt kelpoisuusehto soluissa A1:A10, jos haluat vain yksittäiseen soluu esim C1, niin muuta Intersect(Target, Range("C1"))

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      'solualue mihin haluat kelpoisuusehdon, nyt A1:A10
      If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      Else
      Resetoi
      End If
      End Sub

      tavalliseen moduuliin...
      TeeValikko () tekee uuden hiiren oikean valikon
      voit lisätä uusi kelpoisuusehtoja B sarakkeeseen nyt B39 alkaen.
      LisääKelpoisuusehto() lisää valikosta valitun tiedon aktiiviseen soluun
      PoistaMenu() tyhjentää originaali hiiren oikean valikon
      Sub TeeValikko()
      Dim ctrl As CommandBarControl
      Dim btn As CommandBarControl
      Dim i As Long
      Dim Vika As Long
      Dim Solu As Range
      PoistaMenu
      Set ctrl = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=1)
      'muuta otsikko sopivaksi
      ctrl.Caption = "Lisää tekstit..."
      'voi lisätä uusia kelpoisussehtoja ja koodi päivyttyy automaatisesti
      Vika = Range("B65536").End(xlUp).Row
      For Each Solu In Range("B39:B" & Vika)
      Set btn = ctrl.Controls.Add
      btn.Caption = Solu
      btn.OnAction = "LisääKelpoisuusehto"
      Next
      End Sub

      Private Sub LisääKelpoisuusehto()
      ActiveCell = Application.CommandBars.ActionControl.Caption
      End Sub

      'poistaa kaikki jutut hiiren oikeasta valikosta
      Sub PoistaMenu()
      Dim ctrl As CommandBarControl
      For Each ctrl In Application.CommandBars("Cell").Controls
      ctrl.Delete
      Next
      End Sub

      'palauttaa originaali hiiren oikean valikon
      Sub Resetoi()
      Application.CommandBars("Cell").Reset
      End Sub

      Keep EXCELing
      @Kunde


    • Anonyymi kirjoitti:

      Kunde, kokeilin arpomalla tuota VB-koodiasi vaihtelevalla menestyksellä.
      Osittain sain tuon jopa toimimaan, mutta jotenkin vajaana. Kokeilin vaihtaa koodiin eri mittaisia valikkopituuksia, kuten kohtaan: ("H1:H" & Vika) tilalle: B49:B70 ja ("H65536") -tilalle: ("B50"). Sain kummallisia ilmiöitä.

      Lopetin kokeilemisen, kun en päässyt juuri pidemmälle.
      Mutta.. ei tässä vielä kaikki, kaiken kokeilun jälkeen jäljelle jäi kummallinen ilmiö: eräänlainen haamuvalikko! Tällä tarkoitan sitä, että kun avaan esim. täysin uuden Excel -työkirjan ja klikkaan hiiren oikealla (hiiren kakkosella) satunnaisen solun pällä -on avautuneen apuvalikon yläreunaan ilmestynyt pitkä lista (15 kpl) VB-koodistasi pätkä, eli: "Kelpoisuusehdot..." eli allekkain on 15 kpl noita "Kelpoisuusehdot..." -koodinpätkäsanoja.
      Olen koittanut vaikka mitä kikkoja noiden poistamiseen, mutta selvästikin joku keino on kokeilematta. Mikä ja mistä nuo edes ovat jääneet tuonne roikkumaan, vaikka en enää työstä tuota ko. taulukkoa?

      -aloittaja

      Sun olisi pitänyt suorittaa PoistaMenu() makro... ;-)


    • kunde kirjoitti:

      ko taulukon moduulin ...
      nyt kelpoisuusehto soluissa A1:A10, jos haluat vain yksittäiseen soluu esim C1, niin muuta Intersect(Target, Range("C1"))

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      'solualue mihin haluat kelpoisuusehdon, nyt A1:A10
      If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      Else
      Resetoi
      End If
      End Sub

      tavalliseen moduuliin...
      TeeValikko () tekee uuden hiiren oikean valikon
      voit lisätä uusi kelpoisuusehtoja B sarakkeeseen nyt B39 alkaen.
      LisääKelpoisuusehto() lisää valikosta valitun tiedon aktiiviseen soluun
      PoistaMenu() tyhjentää originaali hiiren oikean valikon
      Sub TeeValikko()
      Dim ctrl As CommandBarControl
      Dim btn As CommandBarControl
      Dim i As Long
      Dim Vika As Long
      Dim Solu As Range
      PoistaMenu
      Set ctrl = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=1)
      'muuta otsikko sopivaksi
      ctrl.Caption = "Lisää tekstit..."
      'voi lisätä uusia kelpoisussehtoja ja koodi päivyttyy automaatisesti
      Vika = Range("B65536").End(xlUp).Row
      For Each Solu In Range("B39:B" & Vika)
      Set btn = ctrl.Controls.Add
      btn.Caption = Solu
      btn.OnAction = "LisääKelpoisuusehto"
      Next
      End Sub

      Private Sub LisääKelpoisuusehto()
      ActiveCell = Application.CommandBars.ActionControl.Caption
      End Sub

      'poistaa kaikki jutut hiiren oikeasta valikosta
      Sub PoistaMenu()
      Dim ctrl As CommandBarControl
      For Each ctrl In Application.CommandBars("Cell").Controls
      ctrl.Delete
      Next
      End Sub

      'palauttaa originaali hiiren oikean valikon
      Sub Resetoi()
      Application.CommandBars("Cell").Reset
      End Sub

      Keep EXCELing
      @Kunde

      Tänks Kunde, otan aiheen vielä työn alle. :D

      -aloittaja


    • kunde kirjoitti:

      Sun olisi pitänyt suorittaa PoistaMenu() makro... ;-)

      Ilmeisesti! ;DD

      -aloittaja


    • kunde kirjoitti:

      ko taulukon moduulin ...
      nyt kelpoisuusehto soluissa A1:A10, jos haluat vain yksittäiseen soluu esim C1, niin muuta Intersect(Target, Range("C1"))

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      'solualue mihin haluat kelpoisuusehdon, nyt A1:A10
      If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      Else
      Resetoi
      End If
      End Sub

      tavalliseen moduuliin...
      TeeValikko () tekee uuden hiiren oikean valikon
      voit lisätä uusi kelpoisuusehtoja B sarakkeeseen nyt B39 alkaen.
      LisääKelpoisuusehto() lisää valikosta valitun tiedon aktiiviseen soluun
      PoistaMenu() tyhjentää originaali hiiren oikean valikon
      Sub TeeValikko()
      Dim ctrl As CommandBarControl
      Dim btn As CommandBarControl
      Dim i As Long
      Dim Vika As Long
      Dim Solu As Range
      PoistaMenu
      Set ctrl = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=1)
      'muuta otsikko sopivaksi
      ctrl.Caption = "Lisää tekstit..."
      'voi lisätä uusia kelpoisussehtoja ja koodi päivyttyy automaatisesti
      Vika = Range("B65536").End(xlUp).Row
      For Each Solu In Range("B39:B" & Vika)
      Set btn = ctrl.Controls.Add
      btn.Caption = Solu
      btn.OnAction = "LisääKelpoisuusehto"
      Next
      End Sub

      Private Sub LisääKelpoisuusehto()
      ActiveCell = Application.CommandBars.ActionControl.Caption
      End Sub

      'poistaa kaikki jutut hiiren oikeasta valikosta
      Sub PoistaMenu()
      Dim ctrl As CommandBarControl
      For Each ctrl In Application.CommandBars("Cell").Controls
      ctrl.Delete
      Next
      End Sub

      'palauttaa originaali hiiren oikean valikon
      Sub Resetoi()
      Application.CommandBars("Cell").Reset
      End Sub

      Keep EXCELing
      @Kunde

      Kunde, nyt menikin sormi suuhun ja tunnustan osaamattomuuteni. :((
      Sain kuitenkin ajettua tuon Sub PoistaMenu() -makron ja tyhjennettyä hiiren oikean valikon turhista "Kelpoisuusehdot..." -riveistä, en aivan onneton näköjään ole. ;D

      Nyt varsinaiseen kysymykseen.
      JOS esim. avaan taulukkoni solun E6 hiiren kakkosnäppäimellä ja haluaisin hiiren oikealle avautuvan kaikki kelpoisuuslistani nimet, eli koko lista näkyisi yhdellä kertaa, mitkä kopioin tuosta VB-koodistasi ja minne? Ja että mitä eroa on:
      ko taulukon moduulin ... ja tavalliseen moduuliin...?
      Sorry, että vähän ehkä yksinkertaisia kyselen. ;D

      -aloittaja


    • Anonyymi kirjoitti:

      Kunde, nyt menikin sormi suuhun ja tunnustan osaamattomuuteni. :((
      Sain kuitenkin ajettua tuon Sub PoistaMenu() -makron ja tyhjennettyä hiiren oikean valikon turhista "Kelpoisuusehdot..." -riveistä, en aivan onneton näköjään ole. ;D

      Nyt varsinaiseen kysymykseen.
      JOS esim. avaan taulukkoni solun E6 hiiren kakkosnäppäimellä ja haluaisin hiiren oikealle avautuvan kaikki kelpoisuuslistani nimet, eli koko lista näkyisi yhdellä kertaa, mitkä kopioin tuosta VB-koodistasi ja minne? Ja että mitä eroa on:
      ko taulukon moduulin ... ja tavalliseen moduuliin...?
      Sorry, että vähän ehkä yksinkertaisia kyselen. ;D

      -aloittaja

      ko taulukon moduulin ...
      tarkoittaa sen taulukon moduulia missä haluat koodia suorittaa, eli jos haluat Taul1
      suorittaa makron , niin kopioi koodit sen moduuliin
      Vasemmalla Project ikkunassa on Microsoft excel Objects ja siellä kaikki taulukon moduulit ja tuplaklikkaa haluamasi taulukon nimeä ja liitä oikealle valkealle ko taulukkoon... koodit

      tavalliseen moduuliin
      ylhäältä valikosta klikkaa INSERT/MODULE ja liitä oikealle valkealle alueelle tavalliseen moduuliin... koodit
      KOODI TOIMII ILMAN ILMAN HIIREN OIKEAN NAPIN KLIKKAUSTA, eli kun menet soluun E6 aukeaa muokattu hiiren oikea valikko ja siinä kelpoisuusehdot. Klikkaat arvoja ja se liitetään soluun . Kun solusta poistutaan palutuu originaali hiiren valikko käyttööön
      Toivottavasti nyt selkeni...

      ko taulukon moduulin ...

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      'solualue mihin haluat kelpoisuusehdon, nyt E6
      If Not Intersect(Target, Range("E6")) Is Nothing Then
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      Else
      Resetoi
      End If
      End Sub

      tavalliseen moduuliin...
      TeeValikko ()
      tekee uuden hiiren oikean valikon
      voit lisätä uusi kelpoisuusehtoja B sarakkeeseen nyt B39 alkaen.
      LisääKelpoisuusehto()
      lisää valikosta valitun tiedon aktiiviseen soluun
      PoistaMenu()
      tyhjentää originaali hiiren oikean valikon
      Resetoi()
      palauttaa orininaali hirren oikean valikon

      Sub TeeValikko()
      Dim ctrl As CommandBarControl
      Dim btn As CommandBarControl
      Dim i As Long
      Dim Vika As Long
      Dim Solu As Range
      PoistaMenu
      Set ctrl = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=1)
      'muuta otsikko sopivaksi
      ctrl.Caption = "Lisää tekstit..."
      'voi lisätä uusia kelpoisussehtoja ja koodi päivyttyy automaatisesti
      Vika = Range("B65536").End(xlUp).Row
      For Each Solu In Range("B39:B" & Vika)
      Set btn = ctrl.Controls.Add
      btn.Caption = Solu
      btn.OnAction = "LisääKelpoisuusehto"
      Next
      End Sub

      Private Sub LisääKelpoisuusehto()
      ActiveCell = Application.CommandBars.ActionControl.Caption
      End Sub

      'poistaa kaikki jutut hiiren oikeasta valikosta
      Sub PoistaMenu()
      Dim ctrl As CommandBarControl
      For Each ctrl In Application.CommandBars("Cell").Controls
      ctrl.Delete
      Next
      End Sub

      'palauttaa originaali hiiren oikean valikon
      Sub Resetoi()
      Application.CommandBars("Cell").Reset
      End Sub

      Keep EXCELing
      @Kunde


    • kunde kirjoitti:

      ko taulukon moduulin ...
      tarkoittaa sen taulukon moduulia missä haluat koodia suorittaa, eli jos haluat Taul1
      suorittaa makron , niin kopioi koodit sen moduuliin
      Vasemmalla Project ikkunassa on Microsoft excel Objects ja siellä kaikki taulukon moduulit ja tuplaklikkaa haluamasi taulukon nimeä ja liitä oikealle valkealle ko taulukkoon... koodit

      tavalliseen moduuliin
      ylhäältä valikosta klikkaa INSERT/MODULE ja liitä oikealle valkealle alueelle tavalliseen moduuliin... koodit
      KOODI TOIMII ILMAN ILMAN HIIREN OIKEAN NAPIN KLIKKAUSTA, eli kun menet soluun E6 aukeaa muokattu hiiren oikea valikko ja siinä kelpoisuusehdot. Klikkaat arvoja ja se liitetään soluun . Kun solusta poistutaan palutuu originaali hiiren valikko käyttööön
      Toivottavasti nyt selkeni...

      ko taulukon moduulin ...

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      'solualue mihin haluat kelpoisuusehdon, nyt E6
      If Not Intersect(Target, Range("E6")) Is Nothing Then
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      Else
      Resetoi
      End If
      End Sub

      tavalliseen moduuliin...
      TeeValikko ()
      tekee uuden hiiren oikean valikon
      voit lisätä uusi kelpoisuusehtoja B sarakkeeseen nyt B39 alkaen.
      LisääKelpoisuusehto()
      lisää valikosta valitun tiedon aktiiviseen soluun
      PoistaMenu()
      tyhjentää originaali hiiren oikean valikon
      Resetoi()
      palauttaa orininaali hirren oikean valikon

      Sub TeeValikko()
      Dim ctrl As CommandBarControl
      Dim btn As CommandBarControl
      Dim i As Long
      Dim Vika As Long
      Dim Solu As Range
      PoistaMenu
      Set ctrl = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=1)
      'muuta otsikko sopivaksi
      ctrl.Caption = "Lisää tekstit..."
      'voi lisätä uusia kelpoisussehtoja ja koodi päivyttyy automaatisesti
      Vika = Range("B65536").End(xlUp).Row
      For Each Solu In Range("B39:B" & Vika)
      Set btn = ctrl.Controls.Add
      btn.Caption = Solu
      btn.OnAction = "LisääKelpoisuusehto"
      Next
      End Sub

      Private Sub LisääKelpoisuusehto()
      ActiveCell = Application.CommandBars.ActionControl.Caption
      End Sub

      'poistaa kaikki jutut hiiren oikeasta valikosta
      Sub PoistaMenu()
      Dim ctrl As CommandBarControl
      For Each ctrl In Application.CommandBars("Cell").Controls
      ctrl.Delete
      Next
      End Sub

      'palauttaa originaali hiiren oikean valikon
      Sub Resetoi()
      Application.CommandBars("Cell").Reset
      End Sub

      Keep EXCELing
      @Kunde

      Kunde kiitos, taas olis paljon mietittävää. ;D
      Palaan!

      -aloittaja


    • kunde kirjoitti:

      ko taulukon moduulin ...
      tarkoittaa sen taulukon moduulia missä haluat koodia suorittaa, eli jos haluat Taul1
      suorittaa makron , niin kopioi koodit sen moduuliin
      Vasemmalla Project ikkunassa on Microsoft excel Objects ja siellä kaikki taulukon moduulit ja tuplaklikkaa haluamasi taulukon nimeä ja liitä oikealle valkealle ko taulukkoon... koodit

      tavalliseen moduuliin
      ylhäältä valikosta klikkaa INSERT/MODULE ja liitä oikealle valkealle alueelle tavalliseen moduuliin... koodit
      KOODI TOIMII ILMAN ILMAN HIIREN OIKEAN NAPIN KLIKKAUSTA, eli kun menet soluun E6 aukeaa muokattu hiiren oikea valikko ja siinä kelpoisuusehdot. Klikkaat arvoja ja se liitetään soluun . Kun solusta poistutaan palutuu originaali hiiren valikko käyttööön
      Toivottavasti nyt selkeni...

      ko taulukon moduulin ...

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      'solualue mihin haluat kelpoisuusehdon, nyt E6
      If Not Intersect(Target, Range("E6")) Is Nothing Then
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      Else
      Resetoi
      End If
      End Sub

      tavalliseen moduuliin...
      TeeValikko ()
      tekee uuden hiiren oikean valikon
      voit lisätä uusi kelpoisuusehtoja B sarakkeeseen nyt B39 alkaen.
      LisääKelpoisuusehto()
      lisää valikosta valitun tiedon aktiiviseen soluun
      PoistaMenu()
      tyhjentää originaali hiiren oikean valikon
      Resetoi()
      palauttaa orininaali hirren oikean valikon

      Sub TeeValikko()
      Dim ctrl As CommandBarControl
      Dim btn As CommandBarControl
      Dim i As Long
      Dim Vika As Long
      Dim Solu As Range
      PoistaMenu
      Set ctrl = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=1)
      'muuta otsikko sopivaksi
      ctrl.Caption = "Lisää tekstit..."
      'voi lisätä uusia kelpoisussehtoja ja koodi päivyttyy automaatisesti
      Vika = Range("B65536").End(xlUp).Row
      For Each Solu In Range("B39:B" & Vika)
      Set btn = ctrl.Controls.Add
      btn.Caption = Solu
      btn.OnAction = "LisääKelpoisuusehto"
      Next
      End Sub

      Private Sub LisääKelpoisuusehto()
      ActiveCell = Application.CommandBars.ActionControl.Caption
      End Sub

      'poistaa kaikki jutut hiiren oikeasta valikosta
      Sub PoistaMenu()
      Dim ctrl As CommandBarControl
      For Each ctrl In Application.CommandBars("Cell").Controls
      ctrl.Delete
      Next
      End Sub

      'palauttaa originaali hiiren oikean valikon
      Sub Resetoi()
      Application.CommandBars("Cell").Reset
      End Sub

      Keep EXCELing
      @Kunde

      Kundelle:
      No niin, täällä taas ihmettelemässä. Koitin olla ohjeesi kanssa tarkka kokeillessani erilaisia vaihtoehtoja, mutta en saanut toimimaan. :((

      Yritän selittää/muistella toimiani..
      Avasin uuden taulukon harjoitusmielessä -en siis tallentanut sitä välillä, vain ainoastaan treenailin.
      Lisäsin taulukkoon alueelle A30-A70 nimilistan ja tein soluun E6 kelpoisuusehdon em. nimilistasta. Avaan hiirellä nuolenkärkivalikon auki ja siellä lista näkyy.
      Nyt kokeilin tod.näk. kaikki vaihtoehdot esittämäsi mukaisesti, mutta en onnistu saamaan kyseistä näkymää.
      Aivan selvästikään en tee jotain oikein.

      Tekemäni taulukko on ns. Ruokalaskuri, jossa ruoat ovat tuossa listassa ja tämä kyseinen toiveeni helpottaisi ruokien poimimista listalta, ettei tarvitsisi vierittää, vaan näkisi kaikki yhdellä kertaa.

      -aloittaja


    • Anonyymi kirjoitti:

      Kundelle:
      No niin, täällä taas ihmettelemässä. Koitin olla ohjeesi kanssa tarkka kokeillessani erilaisia vaihtoehtoja, mutta en saanut toimimaan. :((

      Yritän selittää/muistella toimiani..
      Avasin uuden taulukon harjoitusmielessä -en siis tallentanut sitä välillä, vain ainoastaan treenailin.
      Lisäsin taulukkoon alueelle A30-A70 nimilistan ja tein soluun E6 kelpoisuusehdon em. nimilistasta. Avaan hiirellä nuolenkärkivalikon auki ja siellä lista näkyy.
      Nyt kokeilin tod.näk. kaikki vaihtoehdot esittämäsi mukaisesti, mutta en onnistu saamaan kyseistä näkymää.
      Aivan selvästikään en tee jotain oikein.

      Tekemäni taulukko on ns. Ruokalaskuri, jossa ruoat ovat tuossa listassa ja tämä kyseinen toiveeni helpottaisi ruokien poimimista listalta, ettei tarvitsisi vierittää, vaan näkisi kaikki yhdellä kertaa.

      -aloittaja

      "Lisäsin taulukkoon alueelle A30-A70 nimilistan ja tein soluun E6 kelpoisuusehdon em. nimilistasta. Avaan hiirellä nuolenkärkivalikon auki ja siellä lista näkyy."
      koodiohjessani lukee...
      "tavalliseen moduuliin...
      TeeValikko ()
      tekee uuden hiiren oikean valikon
      voit lisätä uusi kelpoisuusehtoja B sarakkeeseen nyt B39 alkaen."
      eli ei voi näkyä mitään koska listasi A30-A70 eikä B39:Bxxx
      Ja toisekseen ei tarvitse lisätä mitään kelpoisuusehtoja manuaalisesti , koska lista tehdään lennossa hiiren oikeaan valikoon. Muuta listan paikkaa koodissa eli nyt sun testitapauksessa siinä pitäisi olla
      'voi lisätä uusia kelpoisussehtoja ja koodi päivyttyy automaatisesti
      Vika = Range("A65536").End(xlUp).Row
      For Each Solu In Range("A30:A" & Vika)

      Keep EXCELing
      @Kunde


    • kunde kirjoitti:

      "Lisäsin taulukkoon alueelle A30-A70 nimilistan ja tein soluun E6 kelpoisuusehdon em. nimilistasta. Avaan hiirellä nuolenkärkivalikon auki ja siellä lista näkyy."
      koodiohjessani lukee...
      "tavalliseen moduuliin...
      TeeValikko ()
      tekee uuden hiiren oikean valikon
      voit lisätä uusi kelpoisuusehtoja B sarakkeeseen nyt B39 alkaen."
      eli ei voi näkyä mitään koska listasi A30-A70 eikä B39:Bxxx
      Ja toisekseen ei tarvitse lisätä mitään kelpoisuusehtoja manuaalisesti , koska lista tehdään lennossa hiiren oikeaan valikoon. Muuta listan paikkaa koodissa eli nyt sun testitapauksessa siinä pitäisi olla
      'voi lisätä uusia kelpoisussehtoja ja koodi päivyttyy automaatisesti
      Vika = Range("A65536").End(xlUp).Row
      For Each Solu In Range("A30:A" & Vika)

      Keep EXCELing
      @Kunde

      Kunde, NYT rupesi toimimaan!! :DD Kiitos!
      Olin mitä ilmeisemmin jäänyt jumittamaan tuohon kelpoisuusehto-juttuun.. Innostuin jopa hieman virittelemään tuota listan paikkaa, eli sijoitinkin sen tänne: For Each Solu In Range("=Taul2!A30:A70" & Vika) -eli toiselle "välilehdelle". Toimii!

      Kerroinkin tuossa jo aiemmin, että kehittelen sellaista Ruokalaskuria ja siihen tämä on hyvä.
      Vaikka voinkin nyt avata mihin tahansa soluun tuon listan näkymän, pystyykö tuolla koodillasi määrittelemään tietyt solualueet, joissa tuo olisi ainoastaan mahdollista? Esim. solualueilla: B8:B56, F8;F56, J8:J56... jne ja voisin itse lisätä alueita. ;]]

      -aloittaja


    • Anonyymi kirjoitti:

      Kunde, NYT rupesi toimimaan!! :DD Kiitos!
      Olin mitä ilmeisemmin jäänyt jumittamaan tuohon kelpoisuusehto-juttuun.. Innostuin jopa hieman virittelemään tuota listan paikkaa, eli sijoitinkin sen tänne: For Each Solu In Range("=Taul2!A30:A70" & Vika) -eli toiselle "välilehdelle". Toimii!

      Kerroinkin tuossa jo aiemmin, että kehittelen sellaista Ruokalaskuria ja siihen tämä on hyvä.
      Vaikka voinkin nyt avata mihin tahansa soluun tuon listan näkymän, pystyykö tuolla koodillasi määrittelemään tietyt solualueet, joissa tuo olisi ainoastaan mahdollista? Esim. solualueilla: B8:B56, F8;F56, J8:J56... jne ja voisin itse lisätä alueita. ;]]

      -aloittaja

      yksinpuhelua, a'la kolli taas.


    • Anonyymi kirjoitti:

      Kunde, NYT rupesi toimimaan!! :DD Kiitos!
      Olin mitä ilmeisemmin jäänyt jumittamaan tuohon kelpoisuusehto-juttuun.. Innostuin jopa hieman virittelemään tuota listan paikkaa, eli sijoitinkin sen tänne: For Each Solu In Range("=Taul2!A30:A70" & Vika) -eli toiselle "välilehdelle". Toimii!

      Kerroinkin tuossa jo aiemmin, että kehittelen sellaista Ruokalaskuria ja siihen tämä on hyvä.
      Vaikka voinkin nyt avata mihin tahansa soluun tuon listan näkymän, pystyykö tuolla koodillasi määrittelemään tietyt solualueet, joissa tuo olisi ainoastaan mahdollista? Esim. solualueilla: B8:B56, F8;F56, J8:J56... jne ja voisin itse lisätä alueita. ;]]

      -aloittaja

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      'solualue mihin haluat kelpoisuusehdon, nyt
      ' B8:B56, F8;F56, J8:J56
      If Not Intersect(Target, Union(Range("B8:B56"), Range("F8:F56"), Range("J8:J56"))) Is Nothing Then
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      Else
      Resetoi
      End If
      End Sub

      Keep EXCELing
      @Kunde


    • Anonyymi kirjoitti:

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      'solualue mihin haluat kelpoisuusehdon, nyt
      ' B8:B56, F8;F56, J8:J56
      If Not Intersect(Target, Union(Range("B8:B56"), Range("F8:F56"), Range("J8:J56"))) Is Nothing Then
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      Else
      Resetoi
      End If
      End Sub

      Keep EXCELing
      @Kunde

      Kunde, toimii kuin junan vessa!! ;DKiitos!
      Ilmeisesti laitoin tuon viimeisimmän koodisi oikeaan paikkaan, eli Taul1:stä tuplaklikkaamalla avautuvaan tyhjään Taul1(code) kenttään. Siellä se ainakin toimii.

      Kerroin tekeväni Ruokalaskuria, niin siihen liittyen mulla olisi taulukon laskukaavaan liittyvä kysymys, mutta se jää väkisinkin huomiselle.
      Idea on se, että kun noudan soluun jonkun ruokatarvikkeen valikosta, tulee se siis soluun näkyviin. Tämän solun vieressä oikealla on ns. Määrä-solu (grammoina). Seuraavaan soluun oikealle tulisi automaattisesti kilocalorit ko. painolle.
      Tästä huomenna lisää, jos ehdit jelppimään.

      Kiitos vielä tästä!
      -aloittaja


    • Anonyymi kirjoitti:

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      'solualue mihin haluat kelpoisuusehdon, nyt
      ' B8:B56, F8;F56, J8:J56
      If Not Intersect(Target, Union(Range("B8:B56"), Range("F8:F56"), Range("J8:J56"))) Is Nothing Then
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      Else
      Resetoi
      End If
      End Sub

      Keep EXCELing
      @Kunde

      Kunde, Ehdin jo nuolaista, ennen kuin tipahti.. jotain on nyt tapahtunut. :(((
      Eilen näytti ja vaikutti kaikki hyvältä molempien koodisi, eli näiden kahden viimeisimmän kanssa. Suurella varmuudella olin laittanut ne oikeille paikoilleen, koska ne toimivat kokeiltaessa.
      Tänään rupesin innoissani niitä taas testailemaan, kunnes alkoi ns. tökkiminen!
      Tökkiminen ilmeni Excelin jumittumisena, eli "kellottamisena" (se ympyrää pyörivä kuvio..) jonka aikana ei voinut Excelillä tehdä mitään. Lopulta jouduin keskeyttämään "kellottamisen" väkisin tehtäväpalkista hiiren 2.näppäimellä: Sulje ikkuna..tjms.

      Kokeilin avata uusia Excel-työkirjoja tallentamalla makroilla ja ilman.. eri versioita -aina sama lopputulos.
      Mikähän on mahtanut yön aikana tapahtua? ;D

      Laitan nuo viimeisimmät vielä selvyydeksi tähän alas:
      (..tässä toiseksi viimeisin)

      tavalliseen moduuliin...
      TeeValikko ()
      tekee uuden hiiren oikean valikon
      voit lisätä uusi kelpoisuusehtoja B sarakkeeseen nyt B39 alkaen.
      LisääKelpoisuusehto()
      lisää valikosta valitun tiedon aktiiviseen soluun
      PoistaMenu()
      tyhjentää originaali hiiren oikean valikon
      Resetoi()
      palauttaa orininaali hirren oikean valikon

      Sub TeeValikko()
      Dim ctrl As CommandBarControl
      Dim btn As CommandBarControl
      Dim i As Long
      Dim Vika As Long
      Dim Solu As Range
      PoistaMenu
      Set ctrl = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=1)
      'muuta otsikko sopivaksi
      ctrl.Caption = "Lisää tekstit..."
      'voi lisätä uusia kelpoisussehtoja ja koodi päivyttyy automaatisesti
      Vika = Range("B65536").End(xlUp).Row
      For Each Solu In Range("B39:B" & Vika)
      Set btn = ctrl.Controls.Add
      btn.Caption = Solu
      btn.OnAction = "LisääKelpoisuusehto"
      Next
      End Sub

      Private Sub LisääKelpoisuusehto()
      ActiveCell = Application.CommandBars.ActionControl.Caption
      End Sub

      'poistaa kaikki jutut hiiren oikeasta valikosta
      Sub PoistaMenu()
      Dim ctrl As CommandBarControl
      For Each ctrl In Application.CommandBars("Cell").Controls
      ctrl.Delete
      Next
      End Sub

      'palauttaa originaali hiiren oikean valikon
      Sub Resetoi()
      Application.CommandBars("Cell").Reset
      End Sub

      Keep EXCELing
      @Kunde

      (..ja tässä viimeisin)

      Tämän laitoin tyhjään Taul1(code) kenttään...

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      'solualue mihin haluat kelpoisuusehdon, nyt
      ' B8:B56, F8;F56, J8:J56
      If Not Intersect(Target, Union(Range("B8:B56"), Range("F8:F56"), Range("J8:J56"))) Is Nothing Then
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      Else
      Resetoi
      End If
      End Sub

      Keep EXCELing
      @Kunde

      -aloittaja


    • Anonyymi kirjoitti:

      Kunde, Ehdin jo nuolaista, ennen kuin tipahti.. jotain on nyt tapahtunut. :(((
      Eilen näytti ja vaikutti kaikki hyvältä molempien koodisi, eli näiden kahden viimeisimmän kanssa. Suurella varmuudella olin laittanut ne oikeille paikoilleen, koska ne toimivat kokeiltaessa.
      Tänään rupesin innoissani niitä taas testailemaan, kunnes alkoi ns. tökkiminen!
      Tökkiminen ilmeni Excelin jumittumisena, eli "kellottamisena" (se ympyrää pyörivä kuvio..) jonka aikana ei voinut Excelillä tehdä mitään. Lopulta jouduin keskeyttämään "kellottamisen" väkisin tehtäväpalkista hiiren 2.näppäimellä: Sulje ikkuna..tjms.

      Kokeilin avata uusia Excel-työkirjoja tallentamalla makroilla ja ilman.. eri versioita -aina sama lopputulos.
      Mikähän on mahtanut yön aikana tapahtua? ;D

      Laitan nuo viimeisimmät vielä selvyydeksi tähän alas:
      (..tässä toiseksi viimeisin)

      tavalliseen moduuliin...
      TeeValikko ()
      tekee uuden hiiren oikean valikon
      voit lisätä uusi kelpoisuusehtoja B sarakkeeseen nyt B39 alkaen.
      LisääKelpoisuusehto()
      lisää valikosta valitun tiedon aktiiviseen soluun
      PoistaMenu()
      tyhjentää originaali hiiren oikean valikon
      Resetoi()
      palauttaa orininaali hirren oikean valikon

      Sub TeeValikko()
      Dim ctrl As CommandBarControl
      Dim btn As CommandBarControl
      Dim i As Long
      Dim Vika As Long
      Dim Solu As Range
      PoistaMenu
      Set ctrl = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=1)
      'muuta otsikko sopivaksi
      ctrl.Caption = "Lisää tekstit..."
      'voi lisätä uusia kelpoisussehtoja ja koodi päivyttyy automaatisesti
      Vika = Range("B65536").End(xlUp).Row
      For Each Solu In Range("B39:B" & Vika)
      Set btn = ctrl.Controls.Add
      btn.Caption = Solu
      btn.OnAction = "LisääKelpoisuusehto"
      Next
      End Sub

      Private Sub LisääKelpoisuusehto()
      ActiveCell = Application.CommandBars.ActionControl.Caption
      End Sub

      'poistaa kaikki jutut hiiren oikeasta valikosta
      Sub PoistaMenu()
      Dim ctrl As CommandBarControl
      For Each ctrl In Application.CommandBars("Cell").Controls
      ctrl.Delete
      Next
      End Sub

      'palauttaa originaali hiiren oikean valikon
      Sub Resetoi()
      Application.CommandBars("Cell").Reset
      End Sub

      Keep EXCELing
      @Kunde

      (..ja tässä viimeisin)

      Tämän laitoin tyhjään Taul1(code) kenttään...

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      'solualue mihin haluat kelpoisuusehdon, nyt
      ' B8:B56, F8;F56, J8:J56
      If Not Intersect(Target, Union(Range("B8:B56"), Range("F8:F56"), Range("J8:J56"))) Is Nothing Then
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      Else
      Resetoi
      End If
      End Sub

      Keep EXCELing
      @Kunde

      -aloittaja

      jotain varmaan olet tehnyt väärin...
      testaa tolla ja lisäsisn siihen grammat ja kokonaiskalorit kanssa

      https://www.dropbox.com/s/qxy285hwbikwvy0/Kelpoisuusehto oikea valikko.xlsm?dl=0
      Keep EXCELing
      @Kunde


    • kunde kirjoitti:

      jotain varmaan olet tehnyt väärin...
      testaa tolla ja lisäsisn siihen grammat ja kokonaiskalorit kanssa

      https://www.dropbox.com/s/qxy285hwbikwvy0/Kelpoisuusehto oikea valikko.xlsm?dl=0
      Keep EXCELing
      @Kunde

      Moi Kunde. Tein vielä kerran ohjeittesi mukaan uuden (Ruokalaskuri) taulukon, eli..

      taulukon moduuliin laitoin tämän:
      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      'solualue mihin haluat kelpoisuusehdon, nyt
      ' B8:B56, F8;F56, J8:J56
      If Not Intersect(Target, Union(Range("B8:B56"), Range("F8:F56"), Range("J8:J56"))) Is Nothing Then
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      Else
      Resetoi
      End If
      End Sub

      ja..

      tavalliseen moduuliin tämän:
      Sub TeeValikko()
      Dim ctrl As CommandBarControl
      Dim btn As CommandBarControl
      Dim i As Long
      Dim Vika As Long
      Dim Solu As Range
      PoistaMenu
      Set ctrl = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=1)
      'muuta otsikko sopivaksi
      ctrl.Caption = "Lisää tekstit..."
      'voi lisätä uusia kelpoisussehtoja ja koodi päivyttyy automaatisesti
      Vika = Range("B65536").End(xlUp).Row
      For Each Solu In Range("B39:B" & Vika)
      Set btn = ctrl.Controls.Add
      btn.Caption = Solu
      btn.OnAction = "LisääKelpoisuusehto"
      Next
      End Sub

      Private Sub LisääKelpoisuusehto()
      ActiveCell = Application.CommandBars.ActionControl.Caption
      End Sub

      'poistaa kaikki jutut hiiren oikeasta valikosta
      Sub PoistaMenu()
      Dim ctrl As CommandBarControl
      For Each ctrl In Application.CommandBars("Cell").Controls
      ctrl.Delete
      Next
      End Sub

      'palauttaa originaali hiiren oikean valikon
      Sub Resetoi()
      Application.CommandBars("Cell").Reset
      End Sub

      Mielestäni toimin ohjeesi mukaan. Tämä yhdistelmä toimii pienen hetken ja sen jälkeen se alkaa jumittaa eli taas se kellotus.
      Lisäksi tässä on jännä piirre, se ei anna poistaa tai vaihtaa valikon kautta noudettua (ruoka)tuotetta eli solun tyhjennys ei onnistu.

      Sitten tuo Dropboxiin laittamasi taulukko. Kokeilin sitä ja siitä olisi ainesta jatkoon muutamilla viilailuilla. :D
      Olit hyvin päässyt jyvälle Ruokalaskurini ideasta, vaikka en ehtinyt sitä tarkemmin kuvaamaan. Tätä laittamaasi vaivaa sama vika, eli tässäkään ei voi tyhjentää noudettuja ruokavalintoja, eli solua ei voi tyhjentää. Tyhjentäminen on oleellista virhevalintojen varalle.

      Laittamasi malli on hyvinkin toimivan näköinen ulkoisesti ja osaan vaihtaa mieleni mukaiset solualueet näihin:
      If Not Intersect(Target, Union(Range("B8:B56"), Range("F8:F56"), Range("J8:J56"))) Is Nothing Then

      Taul2:ssa olevat sarakkeet ovat muuten OK, mutta annoskoko-sarake on siellä turha, koska se tulee Taul1:een Ruokasarakkeen viereen, johon merkitään syötävän ruoan paino grammoina.
      Yritin myös etsiä ns. laskuoperaatioita koodeistasi. En löytänyt.
      Idea tässä Ruokalaskurissa on se, että ensin valitaan valikosta haluttu ruoka(B-sarakkeeseen). Sen jälkeen laitetaan annoksen paino grammoina(C-sarakkeeseen) ja D-sarakkeeseen tulee tämän ko. annoskoon mukainen kalorimäärä, joka määräytyy Taul2:ssa olevan Kcal/100g mukaisesti. Sinun mallissa Taul2:ssa olevat kalorimäärät pitäisi ensin jakaa 100:lla ja sitten vasta kertoa annoksen painolla (grammoja).

      Ravintotaulukoissa ilmoitetaan esim. Energiamäärä Kcal/100g, eli laskukaava olisi:
      Kcal/100g jaetaan 100:lla ja kerrotaan annoksen grammamäärällä.
      Tätä koitin koodistasi kaivella. :))

      Saakohan tästä mitään selkoa..? ;DD

      -aloittaja


    • Anonyymi kirjoitti:

      Moi Kunde. Tein vielä kerran ohjeittesi mukaan uuden (Ruokalaskuri) taulukon, eli..

      taulukon moduuliin laitoin tämän:
      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      'solualue mihin haluat kelpoisuusehdon, nyt
      ' B8:B56, F8;F56, J8:J56
      If Not Intersect(Target, Union(Range("B8:B56"), Range("F8:F56"), Range("J8:J56"))) Is Nothing Then
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      Else
      Resetoi
      End If
      End Sub

      ja..

      tavalliseen moduuliin tämän:
      Sub TeeValikko()
      Dim ctrl As CommandBarControl
      Dim btn As CommandBarControl
      Dim i As Long
      Dim Vika As Long
      Dim Solu As Range
      PoistaMenu
      Set ctrl = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=1)
      'muuta otsikko sopivaksi
      ctrl.Caption = "Lisää tekstit..."
      'voi lisätä uusia kelpoisussehtoja ja koodi päivyttyy automaatisesti
      Vika = Range("B65536").End(xlUp).Row
      For Each Solu In Range("B39:B" & Vika)
      Set btn = ctrl.Controls.Add
      btn.Caption = Solu
      btn.OnAction = "LisääKelpoisuusehto"
      Next
      End Sub

      Private Sub LisääKelpoisuusehto()
      ActiveCell = Application.CommandBars.ActionControl.Caption
      End Sub

      'poistaa kaikki jutut hiiren oikeasta valikosta
      Sub PoistaMenu()
      Dim ctrl As CommandBarControl
      For Each ctrl In Application.CommandBars("Cell").Controls
      ctrl.Delete
      Next
      End Sub

      'palauttaa originaali hiiren oikean valikon
      Sub Resetoi()
      Application.CommandBars("Cell").Reset
      End Sub

      Mielestäni toimin ohjeesi mukaan. Tämä yhdistelmä toimii pienen hetken ja sen jälkeen se alkaa jumittaa eli taas se kellotus.
      Lisäksi tässä on jännä piirre, se ei anna poistaa tai vaihtaa valikon kautta noudettua (ruoka)tuotetta eli solun tyhjennys ei onnistu.

      Sitten tuo Dropboxiin laittamasi taulukko. Kokeilin sitä ja siitä olisi ainesta jatkoon muutamilla viilailuilla. :D
      Olit hyvin päässyt jyvälle Ruokalaskurini ideasta, vaikka en ehtinyt sitä tarkemmin kuvaamaan. Tätä laittamaasi vaivaa sama vika, eli tässäkään ei voi tyhjentää noudettuja ruokavalintoja, eli solua ei voi tyhjentää. Tyhjentäminen on oleellista virhevalintojen varalle.

      Laittamasi malli on hyvinkin toimivan näköinen ulkoisesti ja osaan vaihtaa mieleni mukaiset solualueet näihin:
      If Not Intersect(Target, Union(Range("B8:B56"), Range("F8:F56"), Range("J8:J56"))) Is Nothing Then

      Taul2:ssa olevat sarakkeet ovat muuten OK, mutta annoskoko-sarake on siellä turha, koska se tulee Taul1:een Ruokasarakkeen viereen, johon merkitään syötävän ruoan paino grammoina.
      Yritin myös etsiä ns. laskuoperaatioita koodeistasi. En löytänyt.
      Idea tässä Ruokalaskurissa on se, että ensin valitaan valikosta haluttu ruoka(B-sarakkeeseen). Sen jälkeen laitetaan annoksen paino grammoina(C-sarakkeeseen) ja D-sarakkeeseen tulee tämän ko. annoskoon mukainen kalorimäärä, joka määräytyy Taul2:ssa olevan Kcal/100g mukaisesti. Sinun mallissa Taul2:ssa olevat kalorimäärät pitäisi ensin jakaa 100:lla ja sitten vasta kertoa annoksen painolla (grammoja).

      Ravintotaulukoissa ilmoitetaan esim. Energiamäärä Kcal/100g, eli laskukaava olisi:
      Kcal/100g jaetaan 100:lla ja kerrotaan annoksen grammamäärällä.
      Tätä koitin koodistasi kaivella. :))

      Saakohan tästä mitään selkoa..? ;DD

      -aloittaja

      https://www.dropbox.com/s/2ufatfv8c36uy3r/Kelpoisuusehto oikea valikko.xlsm?dl=0

      Keep EXCELing
      @Kunde


    • kunde kirjoitti:

      https://www.dropbox.com/s/2ufatfv8c36uy3r/Kelpoisuusehto oikea valikko.xlsm?dl=0

      Keep EXCELing
      @Kunde

      Kunde, kiitos taas vaivannäöstäsi uuden Exceltaulukon viilailusta.
      Omalla vähäisellä tulkintakyvyilläni yritin löytää tämän uuden taulukon koodilisäyksestäsi se oleellisen.. Tässä koodissa se taisi åääosin olla:
      ###
      Dim Löydetty As Range

      Private Sub Worksheet_Change(ByVal Target As Range)
      On Error Resume Next
      Application.EnableEvents = False
      If Not Intersect(Target, Union(Range("C8:C56"), Range("G8:G56"), Range("K8:K56"))) Is Nothing Then
      ' tyhjä annossolu
      If Target = "" Then
      Target.Offset(0, 1) = ""
      Else
      Set Löydetty = EtsiJaSiirrä(Target.Offset(0, -1))
      Target.Offset(0, 1) = Round(Target * Löydetty / 100, 0)
      End If
      End If
      Application.EnableEvents = True
      End Sub
      ###

      En kuitenkaan päässyt jyvälle niin paljon, että olisin kyennyt itse viilaamaan sitä toiveeni mukaiseksi, joten viisainta antaa sinulle tarkat tiedot nykyisestä "manuaalisesti" toimivasta versiostani, jos saisin sulta vielä sen pohjalta uuden taulukon.

      Eli, Ruokalaskuritaulukossa on ydinalueet viikon ajalta tässä:

      -A on pvm-sarake ja vkn päivämäärät soluissa: A5, A12, A19, A26, A33, A40, A47
      -B on Ruokasarake1, jossa solut koko viikolle: B5:B53
      -C on Ruoan paino(g)-sarake, jossa solut koko viikolle: C5:C53
      -D on Kcal-sarake, jossa solut koko viikolle: D5:D53

      -E on Ruokasarake2-sarake, jossa solut koko viikolle: E5:E53
      -F on Ruoan paino(g)-sarake, jossa solut koko viikolle: F5:F53
      -G on Kcal-sarake, jossa solut koko viikolle: G5:G53

      ..jne..

      Näitä kolmen sarakkeen ryhmiä tulee yhteensä 5, eli vielä kolme lisää.
      -H, I, J
      -K, L, M
      -N, O, P

      Manuaalinen taulukkoni toimii näin:

      -Valitsen solu B5 valikosta esim. Aamiaispuuron (valikon sisältö sijaitsee Taul2:ssa B3:B200)
      -C5 soluun näpyttelen puuron painon: 45g
      -D5 soluun tulisi automaattisesti puuroannoksen (esim. 45g) mukainen kalorimäärä, jonka lähde olisi Taul2 C -sarakkeen C3:C200 solun C3 370Kcal/100g.
      Tästä pitäisi saada laskukaava: 370/100x45=166,5.

      Jokaisella ruokatarvikkeella olisi tuolla Taul2:ssa C3:C200 sarakeella ruokakohtainen kalorimäärä 100g kohti muodossa: Kcal/100g.

      Tarkoitus olisi, että voisin hakea mihin tahansa "Ruokasarakkeen" soluun minkä tahansa ruoan ja laittamalla sen punnitun painon Ruoan paino(g) -sarakkeen soluun. Nyt tulisi viereiseen Kcal-sarakkeen soluun automaattisesti punnitun ruoan painon mukainen kalorimäärä.

      Lisäksi vielä sellainen huomio, että vieläkään taulukossasi ei voi poistaa valittua ruokaa solusta, kun sen on siihen valinnut. Voiko tämän muuttaa virhevalintojen varalle, eli valinta pitäisi pystyä perumaan/tyhjentämään.

      Kiitos etukäteen pitkämielisyydestä! ;D

      -aloittaja


    • Anonyymi kirjoitti:

      Kunde, kiitos taas vaivannäöstäsi uuden Exceltaulukon viilailusta.
      Omalla vähäisellä tulkintakyvyilläni yritin löytää tämän uuden taulukon koodilisäyksestäsi se oleellisen.. Tässä koodissa se taisi åääosin olla:
      ###
      Dim Löydetty As Range

      Private Sub Worksheet_Change(ByVal Target As Range)
      On Error Resume Next
      Application.EnableEvents = False
      If Not Intersect(Target, Union(Range("C8:C56"), Range("G8:G56"), Range("K8:K56"))) Is Nothing Then
      ' tyhjä annossolu
      If Target = "" Then
      Target.Offset(0, 1) = ""
      Else
      Set Löydetty = EtsiJaSiirrä(Target.Offset(0, -1))
      Target.Offset(0, 1) = Round(Target * Löydetty / 100, 0)
      End If
      End If
      Application.EnableEvents = True
      End Sub
      ###

      En kuitenkaan päässyt jyvälle niin paljon, että olisin kyennyt itse viilaamaan sitä toiveeni mukaiseksi, joten viisainta antaa sinulle tarkat tiedot nykyisestä "manuaalisesti" toimivasta versiostani, jos saisin sulta vielä sen pohjalta uuden taulukon.

      Eli, Ruokalaskuritaulukossa on ydinalueet viikon ajalta tässä:

      -A on pvm-sarake ja vkn päivämäärät soluissa: A5, A12, A19, A26, A33, A40, A47
      -B on Ruokasarake1, jossa solut koko viikolle: B5:B53
      -C on Ruoan paino(g)-sarake, jossa solut koko viikolle: C5:C53
      -D on Kcal-sarake, jossa solut koko viikolle: D5:D53

      -E on Ruokasarake2-sarake, jossa solut koko viikolle: E5:E53
      -F on Ruoan paino(g)-sarake, jossa solut koko viikolle: F5:F53
      -G on Kcal-sarake, jossa solut koko viikolle: G5:G53

      ..jne..

      Näitä kolmen sarakkeen ryhmiä tulee yhteensä 5, eli vielä kolme lisää.
      -H, I, J
      -K, L, M
      -N, O, P

      Manuaalinen taulukkoni toimii näin:

      -Valitsen solu B5 valikosta esim. Aamiaispuuron (valikon sisältö sijaitsee Taul2:ssa B3:B200)
      -C5 soluun näpyttelen puuron painon: 45g
      -D5 soluun tulisi automaattisesti puuroannoksen (esim. 45g) mukainen kalorimäärä, jonka lähde olisi Taul2 C -sarakkeen C3:C200 solun C3 370Kcal/100g.
      Tästä pitäisi saada laskukaava: 370/100x45=166,5.

      Jokaisella ruokatarvikkeella olisi tuolla Taul2:ssa C3:C200 sarakeella ruokakohtainen kalorimäärä 100g kohti muodossa: Kcal/100g.

      Tarkoitus olisi, että voisin hakea mihin tahansa "Ruokasarakkeen" soluun minkä tahansa ruoan ja laittamalla sen punnitun painon Ruoan paino(g) -sarakkeen soluun. Nyt tulisi viereiseen Kcal-sarakkeen soluun automaattisesti punnitun ruoan painon mukainen kalorimäärä.

      Lisäksi vielä sellainen huomio, että vieläkään taulukossasi ei voi poistaa valittua ruokaa solusta, kun sen on siihen valinnut. Voiko tämän muuttaa virhevalintojen varalle, eli valinta pitäisi pystyä perumaan/tyhjentämään.

      Kiitos etukäteen pitkämielisyydestä! ;D

      -aloittaja

      Huomio-lisäys, valittu ruokasolu voidaankin tyhjentää valitsemalla ns. tyhjä solu valikosta.
      Käyhän se toki näinkin, mutta backspace,- delete,- tai undo-näppäimellä se olisi luonnollisempaa. :))


    • Anonyymi kirjoitti:

      Kunde, kiitos taas vaivannäöstäsi uuden Exceltaulukon viilailusta.
      Omalla vähäisellä tulkintakyvyilläni yritin löytää tämän uuden taulukon koodilisäyksestäsi se oleellisen.. Tässä koodissa se taisi åääosin olla:
      ###
      Dim Löydetty As Range

      Private Sub Worksheet_Change(ByVal Target As Range)
      On Error Resume Next
      Application.EnableEvents = False
      If Not Intersect(Target, Union(Range("C8:C56"), Range("G8:G56"), Range("K8:K56"))) Is Nothing Then
      ' tyhjä annossolu
      If Target = "" Then
      Target.Offset(0, 1) = ""
      Else
      Set Löydetty = EtsiJaSiirrä(Target.Offset(0, -1))
      Target.Offset(0, 1) = Round(Target * Löydetty / 100, 0)
      End If
      End If
      Application.EnableEvents = True
      End Sub
      ###

      En kuitenkaan päässyt jyvälle niin paljon, että olisin kyennyt itse viilaamaan sitä toiveeni mukaiseksi, joten viisainta antaa sinulle tarkat tiedot nykyisestä "manuaalisesti" toimivasta versiostani, jos saisin sulta vielä sen pohjalta uuden taulukon.

      Eli, Ruokalaskuritaulukossa on ydinalueet viikon ajalta tässä:

      -A on pvm-sarake ja vkn päivämäärät soluissa: A5, A12, A19, A26, A33, A40, A47
      -B on Ruokasarake1, jossa solut koko viikolle: B5:B53
      -C on Ruoan paino(g)-sarake, jossa solut koko viikolle: C5:C53
      -D on Kcal-sarake, jossa solut koko viikolle: D5:D53

      -E on Ruokasarake2-sarake, jossa solut koko viikolle: E5:E53
      -F on Ruoan paino(g)-sarake, jossa solut koko viikolle: F5:F53
      -G on Kcal-sarake, jossa solut koko viikolle: G5:G53

      ..jne..

      Näitä kolmen sarakkeen ryhmiä tulee yhteensä 5, eli vielä kolme lisää.
      -H, I, J
      -K, L, M
      -N, O, P

      Manuaalinen taulukkoni toimii näin:

      -Valitsen solu B5 valikosta esim. Aamiaispuuron (valikon sisältö sijaitsee Taul2:ssa B3:B200)
      -C5 soluun näpyttelen puuron painon: 45g
      -D5 soluun tulisi automaattisesti puuroannoksen (esim. 45g) mukainen kalorimäärä, jonka lähde olisi Taul2 C -sarakkeen C3:C200 solun C3 370Kcal/100g.
      Tästä pitäisi saada laskukaava: 370/100x45=166,5.

      Jokaisella ruokatarvikkeella olisi tuolla Taul2:ssa C3:C200 sarakeella ruokakohtainen kalorimäärä 100g kohti muodossa: Kcal/100g.

      Tarkoitus olisi, että voisin hakea mihin tahansa "Ruokasarakkeen" soluun minkä tahansa ruoan ja laittamalla sen punnitun painon Ruoan paino(g) -sarakkeen soluun. Nyt tulisi viereiseen Kcal-sarakkeen soluun automaattisesti punnitun ruoan painon mukainen kalorimäärä.

      Lisäksi vielä sellainen huomio, että vieläkään taulukossasi ei voi poistaa valittua ruokaa solusta, kun sen on siihen valinnut. Voiko tämän muuttaa virhevalintojen varalle, eli valinta pitäisi pystyä perumaan/tyhjentämään.

      Kiitos etukäteen pitkämielisyydestä! ;D

      -aloittaja

      Kunde, väärä hälyytys!! Sain kun sainkin toimimaan! ;DD
      Jostain syystä en hokannut aluksi ideaa.. mutta nyt homma hanskassa.
      Kiitos kovasti. Palaan vielä kysymään jotain jos ilmenee ongelmia. ;D

      Tää on HYVÄ!

      -aloittaja


    • Anonyymi kirjoitti:

      Kunde, väärä hälyytys!! Sain kun sainkin toimimaan! ;DD
      Jostain syystä en hokannut aluksi ideaa.. mutta nyt homma hanskassa.
      Kiitos kovasti. Palaan vielä kysymään jotain jos ilmenee ongelmia. ;D

      Tää on HYVÄ!

      -aloittaja

      no hyvä jos hyvä...
      tässä fiksattuna vähän fiksumpi ja parempi
      Nyt, jos solussa on tekstiä poistaa sen samoinkuin viereisistä soluista ja avaa valikon.
      Ei siis tarvitse mitää delete juttuja ;-)

      https://www.dropbox.com/s/1lk7bfy987ay8k7/Kelpoisuusehto oikea valikko.xlsm?dl=0

      Keep EXCELing
      @Kunde



    • Anonyymi kirjoitti:

      no hyvä jos hyvä...
      tässä fiksattuna vähän fiksumpi ja parempi
      Nyt, jos solussa on tekstiä poistaa sen samoinkuin viereisistä soluista ja avaa valikon.
      Ei siis tarvitse mitää delete juttuja ;-)

      https://www.dropbox.com/s/1lk7bfy987ay8k7/Kelpoisuusehto oikea valikko.xlsm?dl=0

      Keep EXCELing
      @Kunde

      On kyllä hyvä! ;D
      Tsekkaan läpi vielä tämän viimeisimmän koodin, jos on jotain mitä en hokannut lyhyellä tsekkaamisella.
      Tein omasta "manuaaliversiosta" juuri tuollaisen kuin laittamasi viimeisin versio on.
      Jostain syystä I, J, L, M -sarakkeisiin on jäänyt kummittelemaan "Lisää tekstit.." -valikot sarakkeiden soluja klikattaessa, vaikka noissa sarakkeissa ei pitäisi valikkoja ollakaan!? Mistähän mahtanee johtua..



    • Anonyymi kirjoitti:

      Tänks pikku viilauksesta, tsekkaan tämänkin varmaan jo hu su!
      Kerron, mitä huomaan ja saan aikaan. ;D

      -aloittaja

      Pikku viilaus korjaa juurikin tuon edellisen postauksesi kummitusongelman . ..

      Keep EXCEling
      @Kunde


    • kunde kirjoitti:

      Pikku viilaus korjaa juurikin tuon edellisen postauksesi kummitusongelman . ..

      Keep EXCEling
      @Kunde

      Moi Kunde! Kyllä olet tehnyt hyvää duunia! Tämä viimeisin versio viilausten kera toimii aivan täydellisesti. Tuo ruokasolun tyhjennys (ns. väärä valinta) -hiirtä klikkaamalla ko. solussa tyhjentää kaikki kolme vierekkäistä solua yhdellä kertaa. Mukava ominaisuus!
      Ja juu, kummittelevat tekstitkin lähti.. ;D

      Jännä huomata, mitä kohtia osaa itse muuttaa, kunhan on ensin toimiva pohja mitä muuttaa. Montaa kohtaa ei kyllä ollut mitä muuttaa, lähinnä rivien aloituksia, kuten esim. Taul1:ssä 3=>5:een jne.. ja sarakkeiden paikkaa Taul2:ssa. Eipä oikeastaan muuta.

      Tämä toimii ihan kybällä näin, mutta älä ylläty, jos palaan tähän kehittelyn merkeissä. :D

      Kiitos vielä kovasti vaivannäöstäsi!

      -aloittaja


    • kunde kirjoitti:

      Pikku viilaus korjaa juurikin tuon edellisen postauksesi kummitusongelman . ..

      Keep EXCEling
      @Kunde

      Kunde, muutama havainto hyvin toimivasta taulukostasi.

      Tuo viimeisin viilaus taisi poistaa ainakin sen kummitustekstin ja edellinen viilaus taisi korjata sen toivomani ominaisuuden, ettei "ruokasolua" voinut tyhjentää. Vaikkakin ylhältä olisi silloinkin jo voinut valita tyhjän rivin, jota en heti oivaltanut.
      Muutit sen siten, että sitä "ruokasolua" klikkaamalla tyhjeni samalla annos ja kalorisolutkin. Se oli ihan toimiva, eikä siitä valittamista.
      Nyt kun käytin hetken tätä viimeisintä versiota, havaitsin sellaisen jännän ominaisuuden, että kun klikkasi hiirellä vasemmasta reunasta (numerosarakkeesta) jotain riviä, niin HUPS.. koko rivi tyhjeni! Tämähän ei tietenkään ole toivottava ominaisuus ei.. :D

      Samassa yhteydessä tulinkin siihen tulokseen, että solujen tyhjentämisessä (virhevalintojen sattuessa) -tuo aiempi tyhjän solun valitseminen ylhältä onkin parempi -ehkä. Tällä hetkellä tämä vain tuntuu sittenkin paremmalta, eikä ainakaan tule sössittyä koko riviä. ;DD
      Eli palasin siihen tyhjän solun valitsemiseen ylhältä valikosta -versioon.

      Mutta, tein vielä yhden havainnon. JOS haluankin piilottaa ensimmäisen tai pikemminkin edellisen viikon rivit selkeyden vuoksi ei se onnistukaan. Numerosarakkeelta, kun valitsen halutut ed. viikon rivit en pääse hiiren 2:lla valitsemaan "Piilota" -komentoa, vaan siihen tulee se valikkoteksti "Lisää tekstit...".

      Yhteenveto:
      Jos tuon KOKO rivin (vahingossa) poistamisen kerralla -ominaisuuden saisi pois ja rivien piilottamisen haluttaessa -ominaisuuden saisi onnistumaan, niin voisi vielä miettiä olisiko tuo solujen (kolmen solun) tyhjentäminen hiirtä klikkaamalla sittenkin parempi tapa. Aika kätevä se kylläkin on, mutta nyt se ei houkuta, kun riskinä on KOKO rivin tyhjentyminen kerralla. ;D

      -aloittaja


    • Anonyymi kirjoitti:

      Kunde, muutama havainto hyvin toimivasta taulukostasi.

      Tuo viimeisin viilaus taisi poistaa ainakin sen kummitustekstin ja edellinen viilaus taisi korjata sen toivomani ominaisuuden, ettei "ruokasolua" voinut tyhjentää. Vaikkakin ylhältä olisi silloinkin jo voinut valita tyhjän rivin, jota en heti oivaltanut.
      Muutit sen siten, että sitä "ruokasolua" klikkaamalla tyhjeni samalla annos ja kalorisolutkin. Se oli ihan toimiva, eikä siitä valittamista.
      Nyt kun käytin hetken tätä viimeisintä versiota, havaitsin sellaisen jännän ominaisuuden, että kun klikkasi hiirellä vasemmasta reunasta (numerosarakkeesta) jotain riviä, niin HUPS.. koko rivi tyhjeni! Tämähän ei tietenkään ole toivottava ominaisuus ei.. :D

      Samassa yhteydessä tulinkin siihen tulokseen, että solujen tyhjentämisessä (virhevalintojen sattuessa) -tuo aiempi tyhjän solun valitseminen ylhältä onkin parempi -ehkä. Tällä hetkellä tämä vain tuntuu sittenkin paremmalta, eikä ainakaan tule sössittyä koko riviä. ;DD
      Eli palasin siihen tyhjän solun valitsemiseen ylhältä valikosta -versioon.

      Mutta, tein vielä yhden havainnon. JOS haluankin piilottaa ensimmäisen tai pikemminkin edellisen viikon rivit selkeyden vuoksi ei se onnistukaan. Numerosarakkeelta, kun valitsen halutut ed. viikon rivit en pääse hiiren 2:lla valitsemaan "Piilota" -komentoa, vaan siihen tulee se valikkoteksti "Lisää tekstit...".

      Yhteenveto:
      Jos tuon KOKO rivin (vahingossa) poistamisen kerralla -ominaisuuden saisi pois ja rivien piilottamisen haluttaessa -ominaisuuden saisi onnistumaan, niin voisi vielä miettiä olisiko tuo solujen (kolmen solun) tyhjentäminen hiirtä klikkaamalla sittenkin parempi tapa. Aika kätevä se kylläkin on, mutta nyt se ei houkuta, kun riskinä on KOKO rivin tyhjentyminen kerralla. ;D

      -aloittaja

      Hyvä havainto!
      Olen reilut 20 v Exceliä ohjelmoinut ja en ole ikinä törmännyt tohon ja en ole myöskään keskustelupalstoilta havainnut tuota ihmeteltävän.
      Asiahan on tosin ihan looginen, mutta eipä ole ole tullut mieleenkään,että näin voi käydä...
      tossa fiksattuna nyt

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      On Error Resume Next
      Application.EnableEvents = False
      'solualue mihin haluat kelpoisuusehdon, nyt
      ' "B3:B53", "E3:E53", "H3:H53", "K3:K53", "N3:N53"
      'lisää Rangeja union funktion sisään pilkulla eroteltuna
      If Not Intersect(Target, Union(Range("B3:B53"), Range("E3:E53"), Range("H3:H53"), Range("K3:K53"), Range("N3:N53"))) Is Nothing Then
      ' jos solu ei ole tyhjä, niin tyhjentää ja B,C ja D ja vastaavat solut muissa ryhmissä
      'varmistetaan, että vain 1 solu on valittuna...
      If Selection.Count = 1 Then
      If Not Target = "" Then
      Target = ""
      Target.Offset(0, 1) = ""
      Target.Offset(0, 2) = ""
      Target.Offset(0, 1).Select
      Target.Select
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      ' jos solu tyhjä
      Else
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      End If
      End If
      End If
      Resetoi
      Application.EnableEvents = True
      End Sub
      Keep EXCELing
      @Kunde

      .


    • kunde kirjoitti:

      Hyvä havainto!
      Olen reilut 20 v Exceliä ohjelmoinut ja en ole ikinä törmännyt tohon ja en ole myöskään keskustelupalstoilta havainnut tuota ihmeteltävän.
      Asiahan on tosin ihan looginen, mutta eipä ole ole tullut mieleenkään,että näin voi käydä...
      tossa fiksattuna nyt

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      On Error Resume Next
      Application.EnableEvents = False
      'solualue mihin haluat kelpoisuusehdon, nyt
      ' "B3:B53", "E3:E53", "H3:H53", "K3:K53", "N3:N53"
      'lisää Rangeja union funktion sisään pilkulla eroteltuna
      If Not Intersect(Target, Union(Range("B3:B53"), Range("E3:E53"), Range("H3:H53"), Range("K3:K53"), Range("N3:N53"))) Is Nothing Then
      ' jos solu ei ole tyhjä, niin tyhjentää ja B,C ja D ja vastaavat solut muissa ryhmissä
      'varmistetaan, että vain 1 solu on valittuna...
      If Selection.Count = 1 Then
      If Not Target = "" Then
      Target = ""
      Target.Offset(0, 1) = ""
      Target.Offset(0, 2) = ""
      Target.Offset(0, 1).Select
      Target.Select
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      ' jos solu tyhjä
      Else
      TeeValikko
      Application.CommandBars("Cell").ShowPopup
      Target.Offset(0, 1).Select
      End If
      End If
      End If
      Resetoi
      Application.EnableEvents = True
      End Sub
      Keep EXCELing
      @Kunde

      .

      No hyvä, että tulee testailtua, ei mene ihan harakoille palautteeni. ;DD

      Otin heti testiin tuon viimeisimmän korjatun koodauksen. Toimii lähes briljantisti, vain pieni maininta. Solusarakkeisiin: D, G, J, M, P ei tule enää automaattisesti kalorit. Jotain muuttui tässä viimoisessa versiossa! Itse en oivalla missä on syy.. kelpoisuusehdot on ainakin mulla oikeissa soluissa.

      Nyt on muuten kyllä mainoi käyttää tuota solujen tyhjennystä (vahinkovalintojen varalle) -tarvittaessa. Kyllä tämä tapa on kätevämpi nyt.
      Ja sitäpaitsi, kun menin väliaikaisesti edelliseen versioon, siellähän oli taas ne kummittelevat valikkosanat. ;D

      -aloittaja


    • Anonyymi kirjoitti:

      No hyvä, että tulee testailtua, ei mene ihan harakoille palautteeni. ;DD

      Otin heti testiin tuon viimeisimmän korjatun koodauksen. Toimii lähes briljantisti, vain pieni maininta. Solusarakkeisiin: D, G, J, M, P ei tule enää automaattisesti kalorit. Jotain muuttui tässä viimoisessa versiossa! Itse en oivalla missä on syy.. kelpoisuusehdot on ainakin mulla oikeissa soluissa.

      Nyt on muuten kyllä mainoi käyttää tuota solujen tyhjennystä (vahinkovalintojen varalle) -tarvittaessa. Kyllä tämä tapa on kätevämpi nyt.
      Ja sitäpaitsi, kun menin väliaikaisesti edelliseen versioon, siellähän oli taas ne kummittelevat valikkosanat. ;D

      -aloittaja

      Päivityksellä ei ole mitään tekemistä kalorijuttuihin ja aivan eri koodipätkäkin.
      Tarkista , että sulla on oikeat koodit molemmissa eikä sekoitusta... ;-)
      ainoa muutoshan koodissa oli
      If Selection.Count = 1 Then
      ...
      ....
      En d If
      ja tällä varmistetaan , että tyhjennetään vaan annossolu ja 2 viereistä solua
      tässä haetaan kalorit

      tarkista onko sulla Taul2 tiedot näin eli annos B ja kalorit C-sarake
      eli etsitään B sarakkeesta annosta ja C s-sarakkeesta sitten palautetaan vastaava kaloriarvo

      'hakee grammat ja kalorit
      Function EtsiJaSiirrä(Hakuehto As Variant) As Range
      Dim solu As Range
      With Worksheets("Taul2").Range("B:B")
      Set solu = .Find( _
      What:=Hakuehto, _
      LookIn:=xlValues, _
      LookAt:=xlWhole, _
      SearchOrder:=xlByRows, _
      SearchDirection:=xlNext, _
      MatchCase:=False, _
      SearchFormat:=False)
      If Not solu Is Nothing Then
      Set EtsiJaSiirrä = solu.Offset(0, 1)
      End If
      End With
      End Function

      Keep EXCELing
      @Kunde


    • Anonyymi kirjoitti:

      Päivityksellä ei ole mitään tekemistä kalorijuttuihin ja aivan eri koodipätkäkin.
      Tarkista , että sulla on oikeat koodit molemmissa eikä sekoitusta... ;-)
      ainoa muutoshan koodissa oli
      If Selection.Count = 1 Then
      ...
      ....
      En d If
      ja tällä varmistetaan , että tyhjennetään vaan annossolu ja 2 viereistä solua
      tässä haetaan kalorit

      tarkista onko sulla Taul2 tiedot näin eli annos B ja kalorit C-sarake
      eli etsitään B sarakkeesta annosta ja C s-sarakkeesta sitten palautetaan vastaava kaloriarvo

      'hakee grammat ja kalorit
      Function EtsiJaSiirrä(Hakuehto As Variant) As Range
      Dim solu As Range
      With Worksheets("Taul2").Range("B:B")
      Set solu = .Find( _
      What:=Hakuehto, _
      LookIn:=xlValues, _
      LookAt:=xlWhole, _
      SearchOrder:=xlByRows, _
      SearchDirection:=xlNext, _
      MatchCase:=False, _
      SearchFormat:=False)
      If Not solu Is Nothing Then
      Set EtsiJaSiirrä = solu.Offset(0, 1)
      End If
      End With
      End Function

      Keep EXCELing
      @Kunde

      No nyt rupesi pelittämään, aivan aloittelijan mokahan se oli syynä. Jostain syystä tein väärän oletuksen ja kopioin eilisen koodin kokonaan, vaikka vain tämä alue olisi riittänyt:

      'varmistetaan, että vain 1 solu on valittuna...
      If Selection.Count = 1 Then
      ...
      ....
      En d If

      -vaan nyt tämä taas toimii mallikkaasti -juuri toiveen mukaisesti.
      Iso kiitos jälleen parantelusta!

      Köhh.. tuli tässä mieleen..
      En tiedä miten innokas olisit funtsimaan yhtä näppärää ominaisuutta ja että olisiko se edes mahdollista. Vähän näyttää siltä, ettei sulle olisi Excelin kanssa mikään mahdotonta! ;DD

      No joo, mutta ideaani..
      Onnistuisiko Taul2:ssa olevat ruoka-annos- ja kaloritaulukot -josta voi tulla yli 300 riviä pitkä -jakamaan esim. 50 riviä pitkiin vierekkäisiin pätkiin Taul1:ssä ruokasolua klikattaessa. Nyt kun ruokasolua klikkaa, tulee näkyviin pitkä vieritettävä valikko. Tässähän ei tosin näy kuin ruoat, mutta lista on pitkä ja esim. 50 rivin vierekkäin olevia ruokapätkiä mahtuisi varsin monta näytölle. Tämä voisi saada sujuvaksi ruoan hakemisen. :D

      -aloittaja


    • Anonyymi kirjoitti:

      No nyt rupesi pelittämään, aivan aloittelijan mokahan se oli syynä. Jostain syystä tein väärän oletuksen ja kopioin eilisen koodin kokonaan, vaikka vain tämä alue olisi riittänyt:

      'varmistetaan, että vain 1 solu on valittuna...
      If Selection.Count = 1 Then
      ...
      ....
      En d If

      -vaan nyt tämä taas toimii mallikkaasti -juuri toiveen mukaisesti.
      Iso kiitos jälleen parantelusta!

      Köhh.. tuli tässä mieleen..
      En tiedä miten innokas olisit funtsimaan yhtä näppärää ominaisuutta ja että olisiko se edes mahdollista. Vähän näyttää siltä, ettei sulle olisi Excelin kanssa mikään mahdotonta! ;DD

      No joo, mutta ideaani..
      Onnistuisiko Taul2:ssa olevat ruoka-annos- ja kaloritaulukot -josta voi tulla yli 300 riviä pitkä -jakamaan esim. 50 riviä pitkiin vierekkäisiin pätkiin Taul1:ssä ruokasolua klikattaessa. Nyt kun ruokasolua klikkaa, tulee näkyviin pitkä vieritettävä valikko. Tässähän ei tosin näy kuin ruoat, mutta lista on pitkä ja esim. 50 rivin vierekkäin olevia ruokapätkiä mahtuisi varsin monta näytölle. Tämä voisi saada sujuvaksi ruoan hakemisen. :D

      -aloittaja

      Huomenna parit eri vaihtoehdot asian tiimoilta


    • kunde kirjoitti:

      Huomenna parit eri vaihtoehdot asian tiimoilta

      Mahtavaa.. Palaamme huomenna!

      -aloittaja


    • kunde kirjoitti:

      Huomenna parit eri vaihtoehdot asian tiimoilta

      Odottavan aika on pitkä.. =:)) Suorastaan jännityksellä odotan Kundelta ratkaisua Ruokalaskurini viimeisimpään ajatuskudelmaani.

      -aloittaja


    • Anonyymi kirjoitti:

      Odottavan aika on pitkä.. =:)) Suorastaan jännityksellä odotan Kundelta ratkaisua Ruokalaskurini viimeisimpään ajatuskudelmaani.

      -aloittaja

      Hyvää kandee aina odotella... ;-)
      Oli hiukan kiireitä, mutta tossa nyt aakkostettu ruokalista menu. Helppohan se olisi ollut jakaa osiin, mutta vaikea sitten tietää missä osassa annos olisi...
      Useammalle "sarakkeelle " ei voi tehdä. Toki lomake olisi ollut vaihtoehtona, mutta mielestäni tämä kätevin tapa?
      Nyt annokset lajiteltu alkukirjainten mukaan ryhmiin
      Meinasin tehdä koko jututn ribboniin, mutta se liian vaikeata kokemattoman fiksailla sitä...
      Päädyin siis aakkostavaan menuun ja fiksaus helppoa siihen keltaiseeen maalattuun alueeseen Taul2:ssa. Sarakkeessa voi olla enemmänkin rivejä ja jos ei ryhmät riitä ota uusi sarake käyttöön ja lisää koodissa sarake

      https://www.dropbox.com/s/yn4q1sj3bc8ovdv/Kelpoisuusehto oikea valikko.xlsm?dl=0

      Keep EXCELing
      @Kunde


    • kunde kirjoitti:

      Hyvää kandee aina odotella... ;-)
      Oli hiukan kiireitä, mutta tossa nyt aakkostettu ruokalista menu. Helppohan se olisi ollut jakaa osiin, mutta vaikea sitten tietää missä osassa annos olisi...
      Useammalle "sarakkeelle " ei voi tehdä. Toki lomake olisi ollut vaihtoehtona, mutta mielestäni tämä kätevin tapa?
      Nyt annokset lajiteltu alkukirjainten mukaan ryhmiin
      Meinasin tehdä koko jututn ribboniin, mutta se liian vaikeata kokemattoman fiksailla sitä...
      Päädyin siis aakkostavaan menuun ja fiksaus helppoa siihen keltaiseeen maalattuun alueeseen Taul2:ssa. Sarakkeessa voi olla enemmänkin rivejä ja jos ei ryhmät riitä ota uusi sarake käyttöön ja lisää koodissa sarake

      https://www.dropbox.com/s/yn4q1sj3bc8ovdv/Kelpoisuusehto oikea valikko.xlsm?dl=0

      Keep EXCELing
      @Kunde

      ..todellaKIN kannatti odottaa! :D
      Tämä on oikeastaan ihan näppärä tällaisenaan, tästä löytyy helposti ja nopeastikin haluamansa annoksen, verrattuna aiempaan "skrollaamiseen". Enkä nyt sitten tiedä olisiko nuo vierekkäiset annossarakkeet olleet kuitenkaan näin kätevät.

      Mulla olikin valmis sarake lähes sadasta annoksesta ja kaloreista, jotka kopioin ja liitin koodisi Taul2 "annos ja kalorit" sarakkeeseen, sekä lisäsin koodiin riittävästi rivejä. (aiemmin 3-53, nyt ..347 asti) Näin sain tämän toimimaan mukavasti.

      Toistaiseksi mulla ei ole tarvetta lähteä tätä enempää virittelemään. Tämä toimii hyvin ja olen tyytyväinen.
      Kiitän kehittelyistä ja näkemyksistäsi, jotka olivat tervetulleita.
      Tämä on kyllä mahtavaa, kun näet paljon vaivaa meidän noviisien eteen.
      Ainahan tässä itsekin oppii jotain, vaikka ei pyrkisikään tätä tasoa kummempaan.

      Ps. Alunperin mulla oli utopistinen ajatus saada taulukkooni kaikki nuo alla olevat arvot kerättyä, kuten nyt vain tuo Kcal/100g. Taulukosta tulisi ehkä liian "spektaakkelimainen" hallittava, joten tämä saa toistaiseksi riittää. ;D

      -Kcal/100g
      -Rasvaa(g)/100g
      -Hiilihydraatteja(g)/100g
      -Ravintokuituja(g)/100g
      -Proteiineja(g)/100g
      -Suolaa(g)/100g
      -B1-vitamiinia(mg)/100g
      -Magnesiumia(mg)/100g
      -Rautaa(mg)/100g
      Sinkkiä(mg)/100g

      Kiitos!

      -aloittaja


    • w10 sontaa. Paitsi että Windows rikkoi massoittain kovalevyjä, DeLL läppäreitä ja mitä kaikkee tässä kehityshistoriassa olikaan. Ainakin pari kertaa ajanut ihmisten koneet ikuiseen silmukkaan virheellisten päivitysten vuoksi ja aiheuttanut päivien toiminnan katkoja tai uudelleen asennuksia ... On siis joku jolla se on toiminut puoli vuotta ... Lohduttavaa kuulla, ei silti kiinnosta .. Mä en halua mitään microsoft storea pöydälle, windows 10:ssä maksaa pasianssikin .. Eikä lahjakorteilla voinu maksaa ees mediaplayeria 8.1 prolle. Kinuaa pankkikorttia ... Viimeiset on windowsit. Jään eläkkeelle kunhan tää windows ujutus valkenee teillekin ... Itkette vielä aikaa kun XP vallitsi (vanhoilla päivillänne sitten ku windows 7 ja 8 tuli on loppu). Kohta ei oo kiintolevyjäkään vaan kaikki tallennetaan johonkin onedrivelle pakkosyöttönä. Hyvästi yksityisyys ja tietosuoja.
      Windows 10:essä ei ole tietosuojaa minkäänlaista.


    • Anonyymi kirjoitti:

      ..todellaKIN kannatti odottaa! :D
      Tämä on oikeastaan ihan näppärä tällaisenaan, tästä löytyy helposti ja nopeastikin haluamansa annoksen, verrattuna aiempaan "skrollaamiseen". Enkä nyt sitten tiedä olisiko nuo vierekkäiset annossarakkeet olleet kuitenkaan näin kätevät.

      Mulla olikin valmis sarake lähes sadasta annoksesta ja kaloreista, jotka kopioin ja liitin koodisi Taul2 "annos ja kalorit" sarakkeeseen, sekä lisäsin koodiin riittävästi rivejä. (aiemmin 3-53, nyt ..347 asti) Näin sain tämän toimimaan mukavasti.

      Toistaiseksi mulla ei ole tarvetta lähteä tätä enempää virittelemään. Tämä toimii hyvin ja olen tyytyväinen.
      Kiitän kehittelyistä ja näkemyksistäsi, jotka olivat tervetulleita.
      Tämä on kyllä mahtavaa, kun näet paljon vaivaa meidän noviisien eteen.
      Ainahan tässä itsekin oppii jotain, vaikka ei pyrkisikään tätä tasoa kummempaan.

      Ps. Alunperin mulla oli utopistinen ajatus saada taulukkooni kaikki nuo alla olevat arvot kerättyä, kuten nyt vain tuo Kcal/100g. Taulukosta tulisi ehkä liian "spektaakkelimainen" hallittava, joten tämä saa toistaiseksi riittää. ;D

      -Kcal/100g
      -Rasvaa(g)/100g
      -Hiilihydraatteja(g)/100g
      -Ravintokuituja(g)/100g
      -Proteiineja(g)/100g
      -Suolaa(g)/100g
      -B1-vitamiinia(mg)/100g
      -Magnesiumia(mg)/100g
      -Rautaa(mg)/100g
      Sinkkiä(mg)/100g

      Kiitos!

      -aloittaja

      Noi lisätiedothan vosii laittaa vaikka siihen kalorisolun kommenttiin...
      Vähän aikaa sitten postasin tänne koodin kommenttiin kirjoittamisesta ja se pitää lisätä tohon Worksheet_Change tapahtumaan
      Set Löydetty = EtsiJaSiirrä(Target.Offset(0, -1))
      Target.Offset(0, 1) = Round(Target * Löydetty / 100, 0)
      .....
      tähän kommnetti koodi
      ......

      lisäät vaan Taul2 kalorisolujen jatkeeksi nuo tiedot ja sieltä siirrät offsetilla kommenttiin


    • Anonyymi kirjoitti:

      w10 sontaa. Paitsi että Windows rikkoi massoittain kovalevyjä, DeLL läppäreitä ja mitä kaikkee tässä kehityshistoriassa olikaan. Ainakin pari kertaa ajanut ihmisten koneet ikuiseen silmukkaan virheellisten päivitysten vuoksi ja aiheuttanut päivien toiminnan katkoja tai uudelleen asennuksia ... On siis joku jolla se on toiminut puoli vuotta ... Lohduttavaa kuulla, ei silti kiinnosta .. Mä en halua mitään microsoft storea pöydälle, windows 10:ssä maksaa pasianssikin .. Eikä lahjakorteilla voinu maksaa ees mediaplayeria 8.1 prolle. Kinuaa pankkikorttia ... Viimeiset on windowsit. Jään eläkkeelle kunhan tää windows ujutus valkenee teillekin ... Itkette vielä aikaa kun XP vallitsi (vanhoilla päivillänne sitten ku windows 7 ja 8 tuli on loppu). Kohta ei oo kiintolevyjäkään vaan kaikki tallennetaan johonkin onedrivelle pakkosyöttönä. Hyvästi yksityisyys ja tietosuoja.
      Windows 10:essä ei ole tietosuojaa minkäänlaista.

      Täältä apua ongelmaasi:
      https://mieli.fi/fi/tukea-ja-apua


    • kunde kirjoitti:

      Noi lisätiedothan vosii laittaa vaikka siihen kalorisolun kommenttiin...
      Vähän aikaa sitten postasin tänne koodin kommenttiin kirjoittamisesta ja se pitää lisätä tohon Worksheet_Change tapahtumaan
      Set Löydetty = EtsiJaSiirrä(Target.Offset(0, -1))
      Target.Offset(0, 1) = Round(Target * Löydetty / 100, 0)
      .....
      tähän kommnetti koodi
      ......

      lisäät vaan Taul2 kalorisolujen jatkeeksi nuo tiedot ja sieltä siirrät offsetilla kommenttiin

      Haa.. pitääpäs selvittää miten tuo tapahtuu ja onnistunko siinä. Löysin kyllä tuon kommenttiin kirjoittamisen, nyt vain hieman vihkiytymistä. :D
      Tänks Kunde, katsotaan miten saan onnistumaan.. tämä ei siis ole niin tähdellinen, nutta ihan mielenkiinnosta voisin treenailla.

      -aloittaja


    • Anonyymi kirjoitti:

      Haa.. pitääpäs selvittää miten tuo tapahtuu ja onnistunko siinä. Löysin kyllä tuon kommenttiin kirjoittamisen, nyt vain hieman vihkiytymistä. :D
      Tänks Kunde, katsotaan miten saan onnistumaan.. tämä ei siis ole niin tähdellinen, nutta ihan mielenkiinnosta voisin treenailla.

      -aloittaja

      Kunde, itseäni kommentoiden totean, ettei taida pienellä vaivalla eikä miettimisellä onnistua tuo esittämäsi lisäominaisuus. Ruokalaskurini toimii vallan hyvin pelkästään tuolla kaloririvilläkin, joten tyydyn tähän tämänhetkiseen hyvään. :D
      Jos tulen katumapäälle ja kaipaan noita lisäsarakkeita, kysyn tarkentavia ohjeita.

      -aloittaja


    • Anonyymi kirjoitti:

      Kunde, itseäni kommentoiden totean, ettei taida pienellä vaivalla eikä miettimisellä onnistua tuo esittämäsi lisäominaisuus. Ruokalaskurini toimii vallan hyvin pelkästään tuolla kaloririvilläkin, joten tyydyn tähän tämänhetkiseen hyvään. :D
      Jos tulen katumapäälle ja kaipaan noita lisäsarakkeita, kysyn tarkentavia ohjeita.

      -aloittaja

      tossa malli, jota helppo fiksata lisää

      https://www.dropbox.com/s/82z2i3lt80iqamm/Kelpoisuusehto oikea valikko.xlsm?dl=0

      Keep EXCELing
      @Kunde


    • kunde kirjoitti:

      tossa malli, jota helppo fiksata lisää

      https://www.dropbox.com/s/82z2i3lt80iqamm/Kelpoisuusehto oikea valikko.xlsm?dl=0

      Keep EXCELing
      @Kunde

      Ei hittolainen Kunde.. olit aikamoisen koukun laittanut mulle. ;D
      Isokokoinen kiitos!
      Tuossa sun mallitaulukossa tuo näyttää kyllä hyvältä. Kokeilen ensitilassa kopioida tiedot omaan taulukkooni.
      Tämä oli sen verran "turmiollinen" meikäläiselle, että se synnytti heti yhden lisätarpeen.. eli ns. luotu tarve. ;DD
      Eli, mulla on jo NYT omassa taulukossa ruutiini, eli kaavat kerätä ko. päivän kalorit omiin soluihin. Sinun (ensimmäisen viikon vk. 45) mallitaulukossasi ne olisivat soluissa:
      Ma Q5
      Ti Q12
      Ke Q19
      To Q26
      Pe Q33
      La Q40
      Su Q47
      ....
      ....
      jne viikko kerrallaan.

      Ja nyt se syntynyt lisätarve!
      Olisi mahtavaa, jos lisäsarakkeisiinkin R-Z -saisi tuotua nyt kommenttikentissä olevat arvot -päivittäisriveille, kuten nyt jo kerään Q-sarakkeelle kaloreita päiväkohtaisesti.

      Aukesikohan idea? :DD

      -aloittaja


    • Anonyymi kirjoitti:

      Ei hittolainen Kunde.. olit aikamoisen koukun laittanut mulle. ;D
      Isokokoinen kiitos!
      Tuossa sun mallitaulukossa tuo näyttää kyllä hyvältä. Kokeilen ensitilassa kopioida tiedot omaan taulukkooni.
      Tämä oli sen verran "turmiollinen" meikäläiselle, että se synnytti heti yhden lisätarpeen.. eli ns. luotu tarve. ;DD
      Eli, mulla on jo NYT omassa taulukossa ruutiini, eli kaavat kerätä ko. päivän kalorit omiin soluihin. Sinun (ensimmäisen viikon vk. 45) mallitaulukossasi ne olisivat soluissa:
      Ma Q5
      Ti Q12
      Ke Q19
      To Q26
      Pe Q33
      La Q40
      Su Q47
      ....
      ....
      jne viikko kerrallaan.

      Ja nyt se syntynyt lisätarve!
      Olisi mahtavaa, jos lisäsarakkeisiinkin R-Z -saisi tuotua nyt kommenttikentissä olevat arvot -päivittäisriveille, kuten nyt jo kerään Q-sarakkeelle kaloreita päiväkohtaisesti.

      Aukesikohan idea? :DD

      -aloittaja

      Edit: Lisäisn vielä, että kerään kaloreita Q-sarakkeen soluihin päiväkohtaisesti esim. kaavalla: Q5 =SUMMA(D5;G5;J5;M5;P5)

      -aloittaja



    • kunde kirjoitti:

      https://www.dropbox.com/s/sote12qsp1615yj/Kelpoisuusehto oikea valikko.xlsm?dl=0

      Keep EXCELing
      @Kunde

      Kunde, kiitos pikaisesta reagoinnistasi, ihan pelittävä versio tämä viimeisin!
      Sitä hieman tutkiskellen ja mietiskellen tuli mieleen, jos karsisi loppupäästä pois sarakkeet W-Z, eli 4 viimeisintä, kun ravintoarvojen listauksista usein puuttuu nuo neljä viimeisintä, eli siinä mielessä turhia. Samalla taulukkokin selkeytyisi ja saisin tehtyä päiväkohtaiset ns. koontisolut esim. sarakkeisiin X ja Y -alla olevan mukaisesti.

      Kalorit: 2500
      Rasva: 50
      Hiilihydraatit: 1750
      Ravintokuidut: 20
      Proteiinit: 400
      Suola: 4

      Toki sellainenkin käväisi mielessä, jos päiväkohtaisesti olisi voinut kerätä esim. päivän ensimmäiselle riville sarakkeisiin Q-V päivän ravintoarvot. Eli vain päivän ensimmäisen rivin solut sarakkeilta Q-V olisivat toimineet koontisoluina.

      kalorit rasva hiilihydraatit ravintokuidut proteiinit suola
      2500 50 1750 20 400 4

      Tämä jälkimmäinen vaihtoehto olisi selkein, jos sen pystyisi vielä helposti itse toteuttamaan viikosta toiseen. :D

      -aloittaja


    • Anonyymi kirjoitti:

      Kunde, kiitos pikaisesta reagoinnistasi, ihan pelittävä versio tämä viimeisin!
      Sitä hieman tutkiskellen ja mietiskellen tuli mieleen, jos karsisi loppupäästä pois sarakkeet W-Z, eli 4 viimeisintä, kun ravintoarvojen listauksista usein puuttuu nuo neljä viimeisintä, eli siinä mielessä turhia. Samalla taulukkokin selkeytyisi ja saisin tehtyä päiväkohtaiset ns. koontisolut esim. sarakkeisiin X ja Y -alla olevan mukaisesti.

      Kalorit: 2500
      Rasva: 50
      Hiilihydraatit: 1750
      Ravintokuidut: 20
      Proteiinit: 400
      Suola: 4

      Toki sellainenkin käväisi mielessä, jos päiväkohtaisesti olisi voinut kerätä esim. päivän ensimmäiselle riville sarakkeisiin Q-V päivän ravintoarvot. Eli vain päivän ensimmäisen rivin solut sarakkeilta Q-V olisivat toimineet koontisoluina.

      kalorit rasva hiilihydraatit ravintokuidut proteiinit suola
      2500 50 1750 20 400 4

      Tämä jälkimmäinen vaihtoehto olisi selkein, jos sen pystyisi vielä helposti itse toteuttamaan viikosta toiseen. :D

      -aloittaja

      muuta raulukon Private Sub Worksheet_Change(ByVal Target As Range) koodissa
      ...
      Target.Offset(0, 1).Comment.Shape.TextFrame.AutoSize = True
      ' tallnnetaan tiedot ID:hen-kätevä paikka tallentaa tietoja solusta... ;-)
      ' eli tässä tapauksessa annoksen ravintotiedot
      .ID = Round(Target * Löydetty.Offset(0, 1) / 100, 1) & ":" & _
      Round(Target * Löydetty.Offset(0, 2) / 100, 1) & ":" & _
      Round(Target * Löydetty.Offset(0, 3) / 100, 1) & ":" & _
      Round(Target * Löydetty.Offset(0, 4) / 100, 1) & ":" & _
      Round(Target * Löydetty.Offset(0, 5) / 100, 1) & ":"
      End If

      Näin aamutuimaan en ymmärrä näitä... ;-)

      "Samalla taulukkokin selkeytyisi ja saisin tehtyä päiväkohtaiset ns. koontisolut esim. sarakkeisiin X ja Y -alla olevan mukaisesti.

      Kalorit: 2500
      Rasva: 50
      Hiilihydraatit: 1750
      Ravintokuidut: 20
      Proteiinit: 400
      Suola: 4

      Toki sellainenkin käväisi mielessä, jos päiväkohtaisesti olisi voinut kerätä esim. päivän ensimmäiselle riville sarakkeisiin Q-V päivän ravintoarvot. Eli vain päivän ensimmäisen rivin solut sarakkeilta Q-V olisivat toimineet koontisoluina.

      kalorit rasva hiilihydraatit ravintokuidut proteiinit suola
      2500 50 1750 20 400 4"

      Keep EXCEling
      @Kunde


    • kunde kirjoitti:

      muuta raulukon Private Sub Worksheet_Change(ByVal Target As Range) koodissa
      ...
      Target.Offset(0, 1).Comment.Shape.TextFrame.AutoSize = True
      ' tallnnetaan tiedot ID:hen-kätevä paikka tallentaa tietoja solusta... ;-)
      ' eli tässä tapauksessa annoksen ravintotiedot
      .ID = Round(Target * Löydetty.Offset(0, 1) / 100, 1) & ":" & _
      Round(Target * Löydetty.Offset(0, 2) / 100, 1) & ":" & _
      Round(Target * Löydetty.Offset(0, 3) / 100, 1) & ":" & _
      Round(Target * Löydetty.Offset(0, 4) / 100, 1) & ":" & _
      Round(Target * Löydetty.Offset(0, 5) / 100, 1) & ":"
      End If

      Näin aamutuimaan en ymmärrä näitä... ;-)

      "Samalla taulukkokin selkeytyisi ja saisin tehtyä päiväkohtaiset ns. koontisolut esim. sarakkeisiin X ja Y -alla olevan mukaisesti.

      Kalorit: 2500
      Rasva: 50
      Hiilihydraatit: 1750
      Ravintokuidut: 20
      Proteiinit: 400
      Suola: 4

      Toki sellainenkin käväisi mielessä, jos päiväkohtaisesti olisi voinut kerätä esim. päivän ensimmäiselle riville sarakkeisiin Q-V päivän ravintoarvot. Eli vain päivän ensimmäisen rivin solut sarakkeilta Q-V olisivat toimineet koontisoluina.

      kalorit rasva hiilihydraatit ravintokuidut proteiinit suola
      2500 50 1750 20 400 4"

      Keep EXCEling
      @Kunde

      Kiitos jälleen Kunde, testailen tätä mahd. pian. Olen reissussa pari päivää, joten täytyy malttaa itseäni hoppuilemasta. ;D

      Ps. Tuolla:
      ##"Samalla taulukkokin selkeytyisi ja saisin tehtyä päiväkohtaiset ns. koontisolut esim. sarakkeisiin X ja Y -alla olevan... jne

      Tarkoitin, että kun saa taulukon päästä ne turhat 4 saraketta pois, niin jää tilaa X ja Y sarakkeille perustaa yhteenvetosolut päivän ravintoarvoista. Alla malli:

      Kalorit: 2500
      Rasva: 50
      Hiilihydraatit: 1750
      Ravintokuidut: 20
      Proteiinit: 400
      Suola: 4

      -aloittaja


    • Anonyymi kirjoitti:

      Kiitos jälleen Kunde, testailen tätä mahd. pian. Olen reissussa pari päivää, joten täytyy malttaa itseäni hoppuilemasta. ;D

      Ps. Tuolla:
      ##"Samalla taulukkokin selkeytyisi ja saisin tehtyä päiväkohtaiset ns. koontisolut esim. sarakkeisiin X ja Y -alla olevan... jne

      Tarkoitin, että kun saa taulukon päästä ne turhat 4 saraketta pois, niin jää tilaa X ja Y sarakkeille perustaa yhteenvetosolut päivän ravintoarvoista. Alla malli:

      Kalorit: 2500
      Rasva: 50
      Hiilihydraatit: 1750
      Ravintokuidut: 20
      Proteiinit: 400
      Suola: 4

      -aloittaja

      Kunde, ennen kuin teen taulukkooni esittämäsi alla olevan muutoksen, eli vähentämällä ravintoarvosarakkeita neljällä sarakkeella----
      ##
      muuta raulukon Private Sub Worksheet_Change(ByVal Target As Range) koodissa
      ...
      Target.Offset(0, 1).Comment.Shape.TextFrame.AutoSize = True
      ' tallnnetaan tiedot ID:hen-kätevä paikka tallentaa tietoja solusta... ;-)
      ' eli tässä tapauksessa annoksen ravintotiedot
      .ID = Round(Target * Löydetty.Offset(0, 1) / 100, 1) & ":" & _
      Round(Target * Löydetty.Offset(0, 2) / 100, 1) & ":" & _
      Round(Target * Löydetty.Offset(0, 3) / 100, 1) & ":" & _
      Round(Target * Löydetty.Offset(0, 4) / 100, 1) & ":" & _
      Roun
      ##

      ---- ja jos vielä pysyt kärryillä, niin kertoisin tästä viimeisimmästä versiostasi sellaisen huomion, että jos koitan muuttaa rivillä 4 jonkun ravintoarvon nimen etukirjaimen alkamaan isolla kirjaimella (esim. rasva => Rasva) -tyhjentyy koko rivi 4 kaikesta tekstistä.. Koitin jopa muuttaa taulukkoosi tietojen keräämisen alkamaan riviltä 5, kun taulukossasi se alkaa alunperin riviltä 3.
      Tarkasti ottaen on sama mille rivin 4 solulle tekee jotain se lopulta tyhjentää rivin kaikesta tiedosta.
      En löytänyt havaintotaidoillani syytä moiseen. =:[

      Löytäisitköhän sinä tähän ongelmaan ratkaisua. :D

      -aloittaja


    • Anonyymi kirjoitti:

      Kunde, ennen kuin teen taulukkooni esittämäsi alla olevan muutoksen, eli vähentämällä ravintoarvosarakkeita neljällä sarakkeella----
      ##
      muuta raulukon Private Sub Worksheet_Change(ByVal Target As Range) koodissa
      ...
      Target.Offset(0, 1).Comment.Shape.TextFrame.AutoSize = True
      ' tallnnetaan tiedot ID:hen-kätevä paikka tallentaa tietoja solusta... ;-)
      ' eli tässä tapauksessa annoksen ravintotiedot
      .ID = Round(Target * Löydetty.Offset(0, 1) / 100, 1) & ":" & _
      Round(Target * Löydetty.Offset(0, 2) / 100, 1) & ":" & _
      Round(Target * Löydetty.Offset(0, 3) / 100, 1) & ":" & _
      Round(Target * Löydetty.Offset(0, 4) / 100, 1) & ":" & _
      Roun
      ##

      ---- ja jos vielä pysyt kärryillä, niin kertoisin tästä viimeisimmästä versiostasi sellaisen huomion, että jos koitan muuttaa rivillä 4 jonkun ravintoarvon nimen etukirjaimen alkamaan isolla kirjaimella (esim. rasva => Rasva) -tyhjentyy koko rivi 4 kaikesta tekstistä.. Koitin jopa muuttaa taulukkoosi tietojen keräämisen alkamaan riviltä 5, kun taulukossasi se alkaa alunperin riviltä 3.
      Tarkasti ottaen on sama mille rivin 4 solulle tekee jotain se lopulta tyhjentää rivin kaikesta tiedosta.
      En löytänyt havaintotaidoillani syytä moiseen. =:[

      Löytäisitköhän sinä tähän ongelmaan ratkaisua. :D

      -aloittaja

      Löytyy toki..
      tuo oli tiedossa ja ollut siinä koodin lisäyksen alusta alkaen
      no fiksataan se nyt sitten
      muuta raulukon Private Sub Worksheet_Change(ByVal Target As Range) koodissa

      'lasketan päivittäisten ruoka-annosten lisäaineet yhteen
      If Target.Row >= 5 Then
      Range("R" & Target.Row & ":Z" & Target.Row) = ""
      Else: Exit Sub
      End If
      For Each Solu In Union(Range("D" & Target.Row), Range("G" & Target.Row), Range("J" & Target.Row), Range("M" & Target.Row), Range("P" & Target.Row))
      .....
      .....

      Keep EXCELing
      @Kunde


    • Anonyymi kirjoitti:

      Löytyy toki..
      tuo oli tiedossa ja ollut siinä koodin lisäyksen alusta alkaen
      no fiksataan se nyt sitten
      muuta raulukon Private Sub Worksheet_Change(ByVal Target As Range) koodissa

      'lasketan päivittäisten ruoka-annosten lisäaineet yhteen
      If Target.Row >= 5 Then
      Range("R" & Target.Row & ":Z" & Target.Row) = ""
      Else: Exit Sub
      End If
      For Each Solu In Union(Range("D" & Target.Row), Range("G" & Target.Row), Range("J" & Target.Row), Range("M" & Target.Row), Range("P" & Target.Row))
      .....
      .....

      Keep EXCELing
      @Kunde

      No sillä tavalla.. olipas yksinkertainen korjaus. Eipä tuotakaan olisi itse tullut edes kokeilleeksi. 😎
      Tämä toimii kuin se... vessa! Kiitos.
      En tiedä olisiko helppo korjata sellaista jännää ilmiötä, jonka huomasin jo aiemmin, eli kun poistan väärän ruokavalinnan B-sarakkeen solusta hiirellä klikkaamalla tyhjenee myös C ja D solut, kuten pitääkin. Mutta, D-sarakkeen soluun jää "väärän valinnan" kommentti kummittelemaan.
      Pystyykö "väärän" kommentinkin poistamaan automaagisesti B-sarakkeen solua klikkaamalla? 😁

      -aloittaja


    • Anonyymi kirjoitti:

      No sillä tavalla.. olipas yksinkertainen korjaus. Eipä tuotakaan olisi itse tullut edes kokeilleeksi. 😎
      Tämä toimii kuin se... vessa! Kiitos.
      En tiedä olisiko helppo korjata sellaista jännää ilmiötä, jonka huomasin jo aiemmin, eli kun poistan väärän ruokavalinnan B-sarakkeen solusta hiirellä klikkaamalla tyhjenee myös C ja D solut, kuten pitääkin. Mutta, D-sarakkeen soluun jää "väärän valinnan" kommentti kummittelemaan.
      Pystyykö "väärän" kommentinkin poistamaan automaagisesti B-sarakkeen solua klikkaamalla? 😁

      -aloittaja

      losää rivi koodiin
      Private Sub Worksheet_SelectionChange(ByVal Target As Range) proseduurissa
      ...
      Target.Offset(0, 1) = ""
      Target.Offset(0, 2) = ""
      Target.Offset(0, 2).Comment.Delete
      ....
      Keep EXCEing
      @Kunde


  • Perintäfirmat aakkosjärjestykseen alasajoa varten. Loppujärjestyksen saa vain aavistaa. Ikä ja terveys onkin jo loppusuoralla.

  • K0LLI rungarin nysä ihan surkastunut, siksi L-Kauha!

SEISKA.FI

Ketjusta on poistettu 2 sääntöjenvastaista viestiä.