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

662

Ää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. Mitään järkeä?

      Että ollaan erillään? Kummankin pää on kovilla.
      Ikävä
      119
      1692

    2. Noniin rakas

      Annetaanko pikkuhiljaa jo olla, niin ehkä säilyy vienot hymyt kohdatessa. En edelleenkään halua sulle tai kenellekään mi
      Ikävä
      99
      1508

    3. Lasten hyväksikäyttö netissä - Joka 3. nuori on saanut seksuaalisen yhteydenoton pedofiililtä

      Järkyttävää! Lapsiin kohdistuva seksuaalinen hyväksikäyttö verkossa on yhä pahempi ongelma. Ulkolinja: Lasten hyväksikäy
      Maailman menoa
      37
      973

    4. Multa sulle

      Pyörit 24/7 mielessä, kuljet mun mukana, mielessä kyselen sun mielipiteitä, vitsailen sulle, olen sydän auki, aitona. M
      Ikävä
      29
      889

    5. Kumpi vetoaa enemmän sinuun

      Kaivatun ulkonäkö vai persoonallisuus? Ulkonäössä kasvot vai vartalo? Mikä luonteessa viehättää eniten? Mikä ulkonäössä?
      Ikävä
      38
      851

    6. Nainen, olen tutkinut sinua paljon

      Salaisuutesi ei ole minulle salaisuus. Ehkä teimme jonkinlaista vaihtokauppaa kun tutkisimme toisiamme. Meillä oli kumm
      Ikävä
      50
      806

    7. Mies, eihän sulla ole vaimoa tai naisystävää?

      Minusta tuntuu jotenkin, että olisit eronnut joskus, vaikka en edes tiedä onko se totta. Jos oletkin oikeasti edelleen s
      Ikävä
      43
      758

    8. Olet myös vähän ärsyttävä

      Tuntuu, että olet tahallaan nuin vaikeasti tavoiteltava. En tiedä kauanko jaksan tätä näin.
      Ikävä
      37
      750

    9. Okei nyt mä ymmärrän

      Olet siis noin rakastunut, se selittää. Onneksesi tunne on molemminpuolinen 😘
      Ikävä
      56
      748

    10. Onko sulla empatiakykyä?

      Etkö tajua yhtään miltä tämä tuntuu minusta? Minä ainakin yritän ymmärtää miltä sinusta voisi tuntua. En usko, että olet
      Ikävä
      37
      730
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt