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

757

Äänestä

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • kunde

      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.

    • kunde

      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.

    • kunde

      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.

    • kunde

      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ä.

    Takaisin ylös

    Luetuimmat keskustelut

    1. Päivän Sanna: Suomi maailman onnellisin maa

      Sanna muutti Suomen maailman onnellisimmaksi maaksi. Hänen pyyteetön työnsä maailmalla tuottaa edelleen tulosta.
      Maailman menoa
      165
      4055

    2. Taisi kolahtaa....

      Joku kysyi, että miksi S24 sallii kirjoittelun tänne venäläisiltä alustoilta, juttu poistui. Täällähän tosiaan välillä
      Maailman menoa
      39
      2637

    3. Moni islamilainen maa on jo kieltänyt burkat ja nigabit

      mm. Marokko, Tunisia ja Turkki. Miksi he ovat sen tehneet? No perusteet ovat selkeät ja yhteneväiset: turvallisuus, yhte
      Maailman menoa
      94
      2109

    4. Vain puolet SDP:n kannattajista luottaa puoluejohtoon häirintäkohussa

      Ja SDP on ilmoittanut, että ainoa rangaistus häirintään syyllistyneille kansanedustajille on puhuttelu - aina sama. Eli
      Maailman menoa
      82
      1904

    5. Suomi edelleen maailman onnellisin maa

      Olemme hyvällä tiellä. Laitetaan nyt talous kuntoon.
      Maailman menoa
      205
      1784

    6. Kyllä mies pakit kestää

      Herranen aina nyt poijat! 😃 Jos pelkäätte pakkeja noin paljon niin hamekangasta hakemaan. Oon ite saanut useammatkin n
      Ikävä
      27
      1088

    7. Mikä kaivatussasi

      on eniten yllättänyt?
      Ikävä
      72
      1065

    8. Milloin olit onnellinen? Miksi?

      Mikä saa sinut onnelliseksi? Suomi on 9. kertaa maailman onnellisin maa. Kuulutko sinä onnellisten suomalaisten joukkoon
      Sinkut
      147
      781

    9. Miksi ajattelet

      että et riittäisi kaivatullesi?
      Ikävä
      63
      772

    10. Anniina Valtonen odottaa - Sai 2-vuotiaalta lapseltaan napakan heiton!

      Suosikkimeteorologi Anniina Valtonen elää uutta vaihetta elämässään. Hän on kertonut odottavansa toista lasta. Valtonen
      Suomalaiset julkkikset
      28
      771
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt