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ä?
Monimutkaista
8
634
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
Työsuhdepyörän veroetu poistuu
Hallituksen veropoliittisen Riihen uutisia: Mitä ilmeisimmin 1.1.2026 alkaen työsuhdepyörän kuukausiveloitus maksetaan2297080Pakko tulla tänne
jälleen kertomaan kuinka mahtava ja ihmeellinen sekä parhaalla tavalla hämmentävä nainen olet. En ikinä tule kyllästymää451325Fuengirola.fi: Danny avautuu yllättäen ex-rakas Erika Vikmanista: "Sanoisin, että hän on..."
Danny matkasi Aurinkorannikolle Helmi Loukasmäen kanssa. Musiikkineuvoksella on silmää naiskauneudelle ja hänen ex-raka291158- 75921
Hävettää muuttaa Haapavedelle.
Joudun töiden vuoksi muuttamaan Haapavedelle, kun työpaikkani siirtyi sinne. Nyt olen joutunut pakkaamaan kamoja toisaal50915Katseestasi näin
Silmissäsi syttyi hiljainen tuli, Se ei polttanut, vaan muistutti, että olin ennenkin elänyt sinun rinnallasi, jossain a62877Työhuonevähennys poistuu etätyöntekijöiltä
Hyvä. Vituttaa muutenkin etätyöntekijät. Ei se tietokoneen naputtelu mitään työtä ole.96856Toinen kuva mikä susta on jäänyt on
tietynlainen saamattomuus ja laiskuus. Sellaineen narsistinen laiskanpuoleisuus. Palvelkaa ja tehkää.38821Tietenkin täällä
Kunnan kyseenalainen maine kasvaa taas , joku huijannut monen vuoden ajan peltotukia vilpillisin keinoin.14786- 43763