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

741

Ää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. Hallitus pyrkii rajoittamaan kaupan omien halpamerkkien myyntiä

      Helsingin Sanomien mukaan hallitus valmistelee lakihanketta, joka suitsii kaupan valtaa ja rajoittaa omien halpamerkkien
      Yhteiskunta
      239
      3660

    2. Tapettu

      On joku kangaskadulla perjantaina
      Sotkamo
      57
      3383

    3. Björn Wahlroos, maataloustuet lakkautettava

      Sanoo pankkimies. Mitäs persut ja muut tukinulliem perskärpäset tähän? "Wahlroos listaa kansallisen maataloustuen. – I
      Maailman menoa
      89
      2837

    4. Persut päättivät hiilivoiman kieltämisestä Suomessa

      Moni on jo unohanut kuka hyväksyi hiilivoimaloiden kieltämisen Suomessa: persut Sukupuolineutraalit liikennemerkitk
      Maailman menoa
      48
      2646

    5. Työvoimatoimisto

      Nyt kysyisin miksi pitää käydä työvoimatoimistossa paikanpäällä, kun he eivät muuta tee kuin laittavat koneelle uudet ve
      Työttömyys
      112
      2387

    6. Nalle Wahlroos ei ulise kuten Teemu Selänne sähkölaskuista

      Nalle "hah hah" nauroi saamistaan sähkötuista, kun taas Teemu-poika itkeä tirautti kovasta sähkön hinnasta. Nalle nauro
      Maailman menoa
      35
      2042

    7. Muistattekos kuinka kokoomus ja persut vinkuivat sähkön hinnasta?

      Oppositiossa vuonna 2022, kun sähkön hinta uhkasi nousta 20 senttiin kilowattitunnilta? Nyt ovat hiiren hiljaa, kun pitä
      Maailman menoa
      101
      2001

    8. Vain persut vastustivat hiilivoimaloiden alasajoa

      Persut vastusti jyrkästi hiilen kieltolakia ja on myöhemmin vaatinut hiilivoimaloiden pitämistä käytössä. He perusteliva
      Maailman menoa
      42
      1865

    9. Mikä aate kaiken pahan takana?

      Se laiskistuttaa kansat, opettaa vaatimaan etuisuuksia, syleilee maailmoja eikä omaa kansaa.
      Maailman menoa
      104
      1797

    10. Mietin sua liikaa

      Mietin nytkin sitä, että millaista se olisi tulla kotiin, kun sinä olisit täällä vastassa. Tai niin päin, että sinä tuli
      Ikävä
      71
      1149
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt