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?
Onnistuuko phaku vaihteluvälillä?
8
476
Vastaukset
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
Kuvat! Dannyyn liitetty Helmi Loukasmäki, 22, on puhjennut naisena kukkaan - Some sekoaa: "Sä..."
Ooo, kaunis aikuinen nainen Helmistä on kasvanut siinä yli 80-vuotiaan Dannyn rinnalla! Katso uudet kuvat: https://ww614581- 513052
Suodatinpussin kastelemalla saa parempaa kahvia
Kokeilin niksiä ja kyllä tämä kahvi on parempaa nyt. Ei lainkaan maistu paperiselta. Huljuttelee hanan alla suppiloa pap1392330Tidätkö nainen
että suoraan sanottuna v.tut.aa että pääsit näin lähelle minua. Ei olisi oikeasti aikaa tähän mutta silti aina välillä o1051946Mikä on kaivattusi etunimi?
Otsikossa siis on kysymys eriteltynä. Vain oikeat vastaukset hyväksytään.731515Onkohan sinulla kaikki hyvin?
Nyt vähän sellainen outo tunne tuli. Sinun asiasi niin ei minulle toki tarvitse kertoa. Kunhan mietin...381197Huikeeta, mahtavaa, ihan mielettömän upeeta
Me ostettiin talo Espanjasta. Tosin saadaan käyttää sitä vain muutama viikko vuodessa kun on monta muutakin ostajaa! M1931115Oho! Arja Koriseva paljastaa TTK:n ekasta suorasta lähetyksestä: "On vähän ärsyttävä yhtälö!"
Upea Arja Koriseva! Tsemppiä haasteelliseen tilanteeseen! Lue lisää: https://www.suomi24.fi/viihde/oho-arja-koriseva-161082En kestä katsoa
Sitä miten sinusta on muut kiinnostuneita. Olen kateellinen. Siksi pitäisi lähteä pois871078- 1731076