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
580
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
- 1854341
- 341604
Minulta loppuu aika
Halusin olla täydellinen. Nyt näyttää siltä että viimeinen kiristys jää puolitiehen, sillä h-hetki on jo ihan kohta käsi401510Syvälliset keskustelut
Olisivat tärkeintä ensisijaisesti hänen kanssaan Tulisi sellainen hetki, mutta kaikki meni pieleen251494Olisipa sitä henkisesti eheämpi ja rohkeampi
mikään maallinen mammona ei itseäni kiinnosta, eikä sen menetys kiinnostus. Mutta kun kohtaa jonkun sykäyttävän ihmisen,201385- 1121316
Moi, nainen
Tunnustan, olen heikkona sun hymyyn, ja sekään ei auta yhtään, että sulla on täydellinen nenä. Joten ensi kerralla, kun301200Kyllähän tämä vähän kirpaisee
Mutta oman sisäisen rauhan vuoksi jätän sinut nyt historiaan. Todennäköisesti olet jo sinäkin mennyt eteenpäin. Olipah381197- 191149
Sulla on uskomaton luonne
Saat minut hetkessä iloiseksi, tai sanotaan nyt niin, että ajatus sinusta saa sydämeni hyppimään riemusta. En vain saa s441048