Onnistuuko phaku vaihteluvälillä?

Monimutkaista

Olen yrittänyt löytää ratkaisua phaku-funktioon kun hakuarvona on vaihteluväli. Kirjoitan funktiot englanniksi kun en tunne suomenkielisiä vastineita.

Jos hakuarvo on solussa A2 arvona 27,5 ja haluan hakea vlookup-funktiolla kaikki tulokset jotka ovat esimerkiksi 5%/-5% hakuarvosta eli vaihteluvälillä 26,13-28,88. Miten funktion saisi ymmärtämään vaihteluvälin lähdeaineistosta ja vielä siten että solun A2 arvoa voi muuttaa? Tarvitaanko tähän index match funktioita tai joitain muita?

8

715

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • helpoin ja nopein tapa tehdä oma funktio...
      moduuliin...


      soluun kaava esim. =OmaPHaku(G1;A1:A100;5;2), missä

      G1=hakuarvo

      A1:A100= hakualue arvolle

      5= vaihteluväli arvolle /-
      jos eri positiivisilla ja negatiivisella , niin helppo fiksata kaavaan tarvittaessa

      2=sarake
      hakuarvo sarake on 1, joten arvo 2 palauttaa hakusarakkeen oikeanpuolella olevan sarakkeen arvot. Vastaavasti arvolla 0 palauttaisi vasemmanpuoleisen sarakkeen arvot

      Function OmaPHaku(Haku As Double, Hakualue As Range, Vaihteluväli As Double, Sarake As Long)
      Dim Solu As Range
      Dim Tulos As String
      xResult = ""
      For Each Solu In Hakualue
      If Solu >= Haku - (Vaihteluväli / 100) * Haku And Solu <= Haku (Vaihteluväli / 100) * Haku Then
      Tulos = Tulos & Solu.Offset(0, Sarake - 1) & ", "
      End If
      Next
      OmaPHaku = Left(Tulos, Len(Tulos) - 2)
      End Function

      Keep EXCELing
      @Kunde

      • Monimutkaista

        Wow, tämä toimii! Erittäin iso käsi täältä, olet selvästi Excel ammattilainen. Tuo vba on hiukan vieras maailma itselle, täytyy vielä ajatuksella käydä läpi mitä tuossa tapahtuu.

        Mitä moduulissa pitäisi muuttaa, jotta jokainen hakutulos olisi omassa solussa vertikaalisesti?


    • Kundepuu

      moduuliin...

      Dim Tulos() As Double
      Dim i As Integer
      Dim Solu As Range

      Sub OmaPHaku(Haku As Double, Hakualue As String, Vaihteluväli As Double, Sarake As Long)
      i = 0
      ReDim Tulos(0)
      'tulos sarakkeeseen L
      Range("L:L") = ""
      For Each Solu In Range(Hakualue)
      If Solu >= Haku - (Vaihteluväli / 100) * Haku And Solu <= Haku (Vaihteluväli / 100) * Haku Then
      Tulos(i) = Solu.Offset(0, Sarake - 1)
      i = i 1
      ReDim Preserve Tulos(i)
      End If
      Next
      Range("L1").Resize(UBound(Tulos)).Value = Application.WorksheetFunction.Transpose(Tulos)
      End Sub


      'ko.taulukon moduuliin
      'H1 = hakuarvo
      'I1 = hakualue
      'J1 =vaihteluväli
      'K1 = sarake
      Private Sub Worksheet_Change(ByVal Target As Range)
      If Not Intersect(Range("H1:K1"), Target) Is Nothing Then
      OmaPHaku Range("H1"), Range("I1"), Range("J1"), Range("K1")
      End If
      End Sub


      Keep EXCELing
      @Kunde

      • Monimutkaista

        Nyt putosin tai en saa pelittämään.
        En oikein ymmärrä mitä näillä tarkoitat tai voi olla että teen väärin jossain muualla:

        'ko.taulukon moduuliin
        'H1 = hakuarvo
        'I1 = hakualue
        'J1 =vaihteluväli
        'K1 = sarake
        Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Range("H1:K1"), Target) Is Nothing Then
        OmaPHaku Range("H1"), Range("I1"), Range("J1"), Range("K1")
        End If
        End Sub

        Lisään siis uuteen moduulin mutta en ymmärrä viittauksia noihin yksittäisiin soluihin.


    • lisäsit koodin uuteen moduuliin...
      ko taulukon moduuliin tarkoittaa sitä, että koodi lisätään sen taulukon moduuliin missä sen halutaan toimivan. Toki koodata voisin This Workbookiin kanssa, mutta sitten pitää tsekata , että koodi toimii vaan esim. Taul1:ssä eikä muissa. Mutta kätevää toisaalta, jos tarttee useammassa taulukossa samaa koodia....
      eli jos jutut on Taul1:ssä niin kopioi alla oleva koodi siis sinne

      Private Sub Worksheet_Change(ByVal Target As Range)
      If Not Intersect(Range("H1:K1"), Target) Is Nothing Then
      OmaPHaku Range("H1"), Range("I1"), Range("J1"), Range("K1")
      End If
      End Sub

      Taul1 solut ja niiden merkitys on alla ja jos haluat muuttaa niin muutat koodissa
      esim. soluissa tekstit
      'H1 = hakuarvo =27,5
      'I1 = hakualue =B1:B100
      'J1 =vaihteluväli =5
      'K1 = palautettava sarake =2 eli hakualueesta seuraava sarake oikealle tai voi hakea vasemmallekin 0 on eka sarake vasemmalle jne.

    • niin ja oisessa koodin pätkässä siis tulos sarakkeeseen L
      muuta tarvittaessa

      'tulos sarakkeeseen L
      Range("L:L") = ""
      ...
      ...
      ...
      Range("L1").Resize(UBound(Tulos)).Value = Application.WorksheetFunction.Transpose(Tulos)

      Keep EXCELing
      @Kunde

      • Monimutkaista

        Ongelma 1.
        Jos moduulissa;
        Function OmaPHaku(Haku As Double, Hakualue As Range, Vaihteluväli As Double, Sarake As Long)
        Dim Solu As Range
        Dim Tulos As String
        xResult = ""
        For Each Solu In Hakualue
        If Solu >= Haku - (Vaihteluväli / 100) * Haku And Solu <= Haku (Vaihteluväli / 100) * Haku Then
        Tulos = Tulos & Solu.Offset(0, Sarake - 1) & ", "
        End If
        Next
        OmaPHaku = Left(Tulos, Len(Tulos) - 2)
        End Function

        OmaPHaku-funktio löytyy hienosti valikosta ja toimii. Kun laitan moduuliin:

        Dim Tulos() As Double
        Dim i As Integer
        Dim Solu As Range

        Sub OmaPHaku(Haku As Double, Hakualue As String, Vaihteluväli As Double, Sarake As Long)
        i = 0
        ReDim Tulos(0)
        'tulos sarakkeeseen L
        Range("L:L") = ""
        For Each Solu In Range(Hakualue)
        If Solu >= Haku - (Vaihteluväli / 100) * Haku And Solu <= Haku (Vaihteluväli / 100) * Haku Then
        Tulos(i) = Solu.Offset(0, Sarake - 1)
        i = i 1
        ReDim Preserve Tulos(i)
        End If
        Next
        Range("L1").Resize(UBound(Tulos)).Value = Application.WorksheetFunction.Transpose(Tulos)
        End Sub

        Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Range("H1:K1"), Target) Is Nothing Then
        OmaPHaku Range("H1"), Range("I1"), Range("J1"), Range("K1")
        End If
        End Sub

        Ei tunnista koko OmaPhaku-funktiota, eikä löydy funktion lisäys valikosta.

        Ongelma 2.
        Väännetään vielä rautalangasta, eli hakuarvo solussa C2 ja vaihteluväli solussa C1. Hakualue on A24:D600 ja haen sarakkeesta D eli arvolla 4, tällöin:

        Dim Tulos() As Double
        Dim i As Integer
        Dim Solu As Range

        Sub OmaPHaku(Haku As Double, Hakualue As String, Vaihteluväli As Double, Sarake As Long)
        i = 0
        ReDim Tulos(0)
        Range("B:B") = ""
        For Each Solu In Range(Hakualue)
        If Solu >= Haku - (Vaihteluväli / 100) * Haku And Solu <= Haku (Vaihteluväli / 100) * Haku Then
        Tulos(i) = Solu.Offset(0, Sarake - 1)
        i = i 1
        ReDim Preserve Tulos(i)
        End If
        Next
        Range("B").Resize(UBound(Tulos)).Value = Application.WorksheetFunction.Transpose(Tulos)
        End Sub
        Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Range("C2:4"), Target) Is Nothing Then
        OmaPHaku Range("C2"), Range("A24:D600"), Range("C1"), Range("4")
        End If
        End Sub

        Eli tulossarake on B ja kaavassa hakuarvo ja vaihteluväli korvattu soluilla C1 & C2 ja hakualue määritelty.

        Kiitos jos viitsit vielä avustaa, voi kyllä olla että joudun luovuttamaan tämän kanssa kun osaaminen ei riitä vba:n puolella.


    • Et ole ymmärtänyt ohjeitani oikein ja olet sekoittanut nyt vanhaa ja uutta koodia keskenään...

      Väännetään vielä rautalangasta, eli hakuarvo solussa C2 ja vaihteluväli solussa C1. Hakualue on A24:D600 ja haen sarakkeesta D eli arvolla 4, tällöin

      Ensimmäinen koodini oli oma funktio ja jälkimmäinen podtaamani koodi ei ole oma funktio, vaan perustuu solujen muutokseen taulukossa. Eka näkyi, mutta jälkimmäisen ei näy funktiolistassa
      2 eri versiota

      versio1.
      MODUULIIN....

      Sub OmaPHaku(Haku As Double, Hakualue As Range, Vaihteluväli As Double, Sarake As Long)
      i = 0
      ReDim Tulos(0)
      'tulos sarakkeeseen L
      Range("B:B") = ""
      For Each Solu In Hakualue
      If Solu >= Haku - (Vaihteluväli / 100) * Haku And Solu <= Haku (Vaihteluväli / 100) * Haku Then
      Tulos(i) = Solu.Offset(0, Sarake - 1)
      i = i 1
      ReDim Preserve Tulos(i)
      End If
      Next
      Range("B1").Resize(UBound(Tulos)).Value = Application.WorksheetFunction.Transpose(Tulos)
      End Sub

      SEN TAULUKON MODUULIIN MISSÄ TIEDOT ON ESIM TAUL1 MODUULIIN....
      Taul1 solut ja niiden merkitys on alla ja jos haluat muuttaa niin muutat koodissa
      esim. soluissa tekstit
      'C1 = hakuarvo =27,5
      'C2 = vaihteluväli=10
      hakualue har codattu koodiin samoin kuin sarake

      Private Sub Worksheet_Change(ByVal Target As Range)
      Application.EnableEvents = False
      If Not Intersect(Range("C1:C2"), Target) Is Nothing Then
      OmaPHaku Range("C1"), Range("A24:D600"), Range("C2"), 4
      End If
      Application.EnableEvents = True
      End Sub

      versio 2
      mitä tarjosin aluksi, siinä voi hakualueen ja sarakkeen kanssa syöttää soluihin

      MODUULIIN...

      Sub OmaPHaku(Haku As Double, Hakualue As String, Vaihteluväli As Double, Sarake As Long)
      i = 0
      ReDim Tulos(0)
      'tulos sarakkeeseen L
      Range("B:B") = ""
      For Each Solu In Range(Hakualue)
      If Solu >= Haku - (Vaihteluväli / 100) * Haku And Solu <= Haku (Vaihteluväli / 100) * Haku Then
      Tulos(i) = Solu.Offset(0, Sarake - 1)
      i = i 1
      ReDim Preserve Tulos(i)
      End If
      Next
      Range("B1").Resize(UBound(Tulos)).Value = Application.WorksheetFunction.Transpose(Tulos)
      End Sub


      SEN TAULUKON MODUULIIN MISSÄ TIEDOT ON ESIM TAUL1 MODUULIIN....
      Taul1 solut ja niiden merkitys on alla ja jos haluat muuttaa niin muutat koodissa
      esim. soluissa tekstit
      'C1 = hakuarvo =27,5
      'C2 = vaihteluväli=10
      'C3= hakualue=A24:D600
      'C4= sarake=4

      Private Sub Worksheet_Change(ByVal Target As Range)
      On Error Resume Next
      Application.EnableEvents = False
      If Not Intersect(Range("C1:C4"), Target) Is Nothing Then
      OmaPHaku Range("C1"), Range("C3"), Range("C2"), Range("C4")
      End If
      Application.EnableEvents = True
      End Sub


      Keep EXCELing
      @Kunde

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

    Luetuimmat keskustelut

    1. Jalankulkija kuoli. Poliisi etsii mustaa BMW Coupe -autoa, jossa on punertavat vanteet.

      Jalankulkija kuoli jäätyään auton alle Joensuussa – kuljettaja pakeni, poliisi pyytää havaintoja https://www.mtvuutiset.
      Joensuu
      201
      4609
    2. Mikä vasemmistolaisista jankkaavaa vaivaa?

      Pahasti on ihon alle, siis korvien väliin sinne tyhjään tilaan, päässeet kummittelemaan. Ei ole terveen ihmisen merkki
      Maailman menoa
      31
      3210
    3. Ohjelma "Rikollisjengien Ruotsi" hyvin paljasti jakautuneen maan

      eli ns. ruotsalaiset yhdellä puolella, muslimit ja muut kehitysmaalaiset toisella puolella. Siinäkin hyvin näki mitä ma
      Maailman menoa
      33
      2921
    4. PÄIVÄN PARAS: Nigerialainen haki turvapaikkaa Suomesta, lähti takas huilaamaan

      kotimaahansa, koska turvapaikan saaminen kesti niin kauan. Ja tämän kertoo ihan Yle, eikä yhtään toimittaja kyseenalaist
      Maailman menoa
      81
      2854
    5. Vassarina hymyilyttää vaurastuminen persujen kustannuksella

      Olen sijottanut määrätietoisesti osan Kelan tuista pörssiosakkeisiin, ja salkku on paisunut jo toiselle sadalle tuhanne
      Maailman menoa
      60
      2796
    6. Riikka runnoo: Elisalta potkut 400:lle

      Erinomaisen hallitusohjelman tavoite 100 000 työllistä lisää yksityisellä sektorilla on kohta saavutettu. Toivotaan toiv
      Maailman menoa
      90
      2635
    7. Pidennetään viikko 8 päiväiseksi

      Ja jätetään työpäivien määrä nykyiseen 5:een. Tuo olisi kompromissiratkaisu vellovaan keskusteluun työajan lyhentämisest
      Maailman menoa
      14
      2381
    8. Pääseekö kuka tahansa hoitaja katselemaan kenen tahansa ihmisen terveystietoja?

      "Meeri selaili puhelinta uteliaisuuttaan ja katuu nyt – Moni hoitaja on tehnyt saman rikoksen Tuttujen ihmisten asiat k
      Maailman menoa
      100
      2159
    9. Miksi eristäydyt?

      Onko jokin syy kun vetäydyt omiin oloihin?
      Ikävä
      126
      1428
    10. Missä me nähtiin viimeksi nainen

      Paikka ja siitä vähän kuvailua. Mitä kohtaamisessa tapahtui?
      Ikävä
      63
      1158
    Aihe