Pitäisi saada poimittua eri taulukoista yhteenveto ensimmäisen taulukon hakusanalle.
Esim Taul1 A1 on hakusana kenttä ja siihen on kirjoitettu Ruka
Taul2 on A-sarakkeessa sanoja Ruka, Levi, Ylläs, Pallas ja näiden jälkeen on B,C,D,E,F kentissä tietoja
Taul3 on A-sarakkeessa sarakkeessa samoin Ruka, Levi,Ylläs,Pallas ja taas tietoja sarakkeissa B, C ja D.
Nyt kun luo Comman Buttonin niin sen pitäisi hakea hakusanalla vastaavat tiedot Taul2 kentistä ja Taul3 kentistä ja viedä ne yhteenvetona takaisin Taul1 ensimmäiselle vapaalle riville.
Kauhian helppo, vaan ei mulle =(
Macro Problem
10
321
Vastaukset
- ettätälleen
menis ihan PHAKU-funktiolla
A2=JOS($A$1="";"";PHAKU($A$1;Taul2!$A$1:$F$4;2;0) - muuta kaavaan tuo hakualue oikeaksi, nyt Taul2A1:F4
Kopioit kaavan "kahvasta" B2:F2 ja muutat sitten niihin tuon haettavan tiedon sarakenumeron. eli tuon toiseksiviimeisen luvun (2) kaavassa muutat 3, sitten 4 ,5 ja 6
G2=JOS($A$1="";"";PHAKU($A$1;Taul3!$A$1:$F$4;2;0) - kopioi kaava ja muutat taas kahteen viimeiseen haettavat sarakenumerot oikeiksi (3 ja 4)
Kakkosrivi pysyy nyt tyhjänä jos A1 on tyhjä ja haettavat tiedot ilmestyy toiselle riville kun kirjoitat A1:seen
Nuo kaavat voi ja ehkä kannattaakin sijoittaa alekkain (A2:A9) jos haettavat tiedot ovat pitkiä- Oligo
No joo toimii, mutta Taul 3 hakee vain ensimmäiset tiedot eli tuolla hakusanalla voi taulukossa olla muitakin rivejä kuin pelkästään yksi eli pitäisi tuoda kaikki rivit alekain joissa hakusana esiintyy, muuten toimiva.
Oligo kirjoitti:
No joo toimii, mutta Taul 3 hakee vain ensimmäiset tiedot eli tuolla hakusanalla voi taulukossa olla muitakin rivejä kuin pelkästään yksi eli pitäisi tuoda kaikki rivit alekain joissa hakusana esiintyy, muuten toimiva.
lisäämällä toisen haun ja muuttelemalla solualueita toimiva versio...
http://keskustelu.suomi24.fi/node/6001900#comment-31562054- Oligo
kunde kirjoitti:
lisäämällä toisen haun ja muuttelemalla solualueita toimiva versio...
http://keskustelu.suomi24.fi/node/6001900#comment-31562054ok, tuo makro on hyvä, mutta miten saan että se hakee myös Taul 3:lta ja Taul4:lta tarvittaessa tiedot, nyt hakee vain Taul2:lta tiedot
Oligo kirjoitti:
ok, tuo makro on hyvä, mutta miten saan että se hakee myös Taul 3:lta ja Taul4:lta tarvittaessa tiedot, nyt hakee vain Taul2:lta tiedot
ja toiveesi toteutui...
muuta sopivaksi...
Function EtsiJaSiirrä(Hakuehto As Variant, Taulukko As String) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets(Taulukko).Activate
With Range("A:A")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function
Sub Testi()
Dim Löydetty As Range
Dim Löydetty2 As Range
Dim Löydetty3 As Range
On Error GoTo virhe
Set Löydetty = EtsiJaSiirrä(Range("Sheet1!A1"), "Sheet2").EntireRow
Union(Löydetty, Löydetty).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
Set Löydetty2 = EtsiJaSiirrä(Range("Sheet1!A1"), "Sheet3").EntireRow
Union(Löydetty2, Löydetty2).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
Set Löydetty3 = EtsiJaSiirrä(Range("Sheet1!A1"), "Sheet4").EntireRow
Union(Löydetty3, Löydetty3).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
Worksheets("Sheet1").Activate
Range("A1").Select
Exit Sub
virhe:
MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
Worksheets("Sheet1").Activate
Range("A1").Select
End Sub- Oligo
kunde kirjoitti:
ja toiveesi toteutui...
muuta sopivaksi...
Function EtsiJaSiirrä(Hakuehto As Variant, Taulukko As String) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets(Taulukko).Activate
With Range("A:A")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function
Sub Testi()
Dim Löydetty As Range
Dim Löydetty2 As Range
Dim Löydetty3 As Range
On Error GoTo virhe
Set Löydetty = EtsiJaSiirrä(Range("Sheet1!A1"), "Sheet2").EntireRow
Union(Löydetty, Löydetty).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
Set Löydetty2 = EtsiJaSiirrä(Range("Sheet1!A1"), "Sheet3").EntireRow
Union(Löydetty2, Löydetty2).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
Set Löydetty3 = EtsiJaSiirrä(Range("Sheet1!A1"), "Sheet4").EntireRow
Union(Löydetty3, Löydetty3).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
Worksheets("Sheet1").Activate
Range("A1").Select
Exit Sub
virhe:
MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
Worksheets("Sheet1").Activate
Range("A1").Select
End Subnyt alkaa olla hyvällä mallilla, mitenkäs tämän sais vielä command buttonin taakse?
täytyy kyllä myöntää että luulin osaavani jotain, vittu enhän mä osaakaan! Oligo kirjoitti:
nyt alkaa olla hyvällä mallilla, mitenkäs tämän sais vielä command buttonin taakse?
täytyy kyllä myöntää että luulin osaavani jotain, vittu enhän mä osaakaan!liitä makro moduuliin ja tee nappi joko
Kontrolli työkaluilla ja tuplaklikkaat nappia, jolloin koodisivu aukeaa ja lisäät makron nimen rivien väliin esim.
Private Sub CommandButton1_Click()
Testi
End Sub
tai jos teit sen Lomake työkaluilla niin liität Testi makron nappiin
Klara Vappen!
Keep Excelling
@Kunde- Oligo
kunde kirjoitti:
liitä makro moduuliin ja tee nappi joko
Kontrolli työkaluilla ja tuplaklikkaat nappia, jolloin koodisivu aukeaa ja lisäät makron nimen rivien väliin esim.
Private Sub CommandButton1_Click()
Testi
End Sub
tai jos teit sen Lomake työkaluilla niin liität Testi makron nappiin
Klara Vappen!
Keep Excelling
@Kundesimaa tässä kaipailee mutta ei vielä kun ei luonnistu prkele!
Buttonin takana nyt näin, vaan ei toimi oikein:
Private Sub CommandButton2_Click()
Function EtsiJaSiirrä(Hakuehto As Variant, Haku As String) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Taul2").Activate
With Range("A:A")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function
Function EtsiJaSiirrä2(Hakuehto As Variant, Haku As String) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Taul3").Activate
With Range("A:A")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä2 = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä2 = Union(EtsiJaSiirrä2, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function
Function EtsiJaSiirrä3(Hakuehto As Variant, Haku As String) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Taul4").Activate
With Range("A:A")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä3 = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä3 = Union(EtsiJaSiirrä3, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function
Dim Löydetty As Range
Dim Löydetty2 As Range
Dim Löydetty3 As Range
On Error GoTo virhe
Set Löydetty = EtsiJaSiirrä(Range("Haku!A1"), "Taul2").EntireRow
Union(Löydetty, Löydetty).Copy Range("Haku!A3:A65536").End(xlUp).Offset(1, 0).EntireRow
Set Löydetty2 = EtsiJaSiirrä2(Range("Haku!A1"), "Taul3").EntireRow
Union(Löydetty2, Löydetty2).Copy Range("Haku!A7:A65536").End(xlUp).Offset(1, 0).EntireRow
Set Löydetty3 = EtsiJaSiirrä3(Range("Haku!A1"), "Taul4").EntireRow
Union(Löydetty3, Löydetty3).Copy Range("Haku!A65536").End(xlUp).Offset(1, 0).EntireRow
Worksheets("Haku").Activate
Range("A1").Select
Exit Sub
virhe:
MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
Worksheets("Haku").Activate
Range("A1").Select
End Sub
Ilman nappia saan toimimaan, mutta en tuolla napilla... - Oligo
Oligo kirjoitti:
simaa tässä kaipailee mutta ei vielä kun ei luonnistu prkele!
Buttonin takana nyt näin, vaan ei toimi oikein:
Private Sub CommandButton2_Click()
Function EtsiJaSiirrä(Hakuehto As Variant, Haku As String) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Taul2").Activate
With Range("A:A")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function
Function EtsiJaSiirrä2(Hakuehto As Variant, Haku As String) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Taul3").Activate
With Range("A:A")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä2 = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä2 = Union(EtsiJaSiirrä2, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function
Function EtsiJaSiirrä3(Hakuehto As Variant, Haku As String) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Taul4").Activate
With Range("A:A")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä3 = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä3 = Union(EtsiJaSiirrä3, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function
Dim Löydetty As Range
Dim Löydetty2 As Range
Dim Löydetty3 As Range
On Error GoTo virhe
Set Löydetty = EtsiJaSiirrä(Range("Haku!A1"), "Taul2").EntireRow
Union(Löydetty, Löydetty).Copy Range("Haku!A3:A65536").End(xlUp).Offset(1, 0).EntireRow
Set Löydetty2 = EtsiJaSiirrä2(Range("Haku!A1"), "Taul3").EntireRow
Union(Löydetty2, Löydetty2).Copy Range("Haku!A7:A65536").End(xlUp).Offset(1, 0).EntireRow
Set Löydetty3 = EtsiJaSiirrä3(Range("Haku!A1"), "Taul4").EntireRow
Union(Löydetty3, Löydetty3).Copy Range("Haku!A65536").End(xlUp).Offset(1, 0).EntireRow
Worksheets("Haku").Activate
Range("A1").Select
Exit Sub
virhe:
MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
Worksheets("Haku").Activate
Range("A1").Select
End Sub
Ilman nappia saan toimimaan, mutta en tuolla napilla...ei vittu olen simassa, onnistu.
Kiitos suuresta jelpistä, simalasin auki sulle.
Klara Vappen! Oligo kirjoitti:
ei vittu olen simassa, onnistu.
Kiitos suuresta jelpistä, simalasin auki sulle.
Klara Vappen!Private Sub CommandButton2_Click()
Dim Löydetty As Range
Dim Löydetty2 As Range
Dim Löydetty3 As Range
On Error GoTo virhe
Set Löydetty = EtsiJaSiirrä(Range("Sheet1!A1"), "Sheet2").EntireRow
Union(Löydetty, Löydetty).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
Set Löydetty2 = EtsiJaSiirrä(Range("Sheet1!A1"), "Sheet3").EntireRow
Union(Löydetty2, Löydetty2).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
Set Löydetty3 = EtsiJaSiirrä(Range("Sheet1!A1"), "Sheet4").EntireRow
Union(Löydetty3, Löydetty3).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
Worksheets("Sheet1").Activate
Range("A1").Select
Exit Sub
virhe:
MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
Worksheets("Sheet1").Activate
Range("A1").Select
End Sub
Function EtsiJaSiirrä(Hakuehto As Variant, Taulukko As String) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets(Taulukko).Activate
With Range("A:A")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
- 1581991
Kun viimeksi kohtasitte/näitte
Mitä olitte tekemässä? Millainen ympäristö oli? Löydetään toisemme...1311774Olet kyllä vaarallisen himokas
Luova, kaunis, määrätietoinen, pervo, mielenkiintoinen, kovanaama, naisellinen ja erikoinen.1021547- 721240
Anna vielä vähän vihreää valoa
Teen sitten siirtoni, nainen. Tiedän, että olet jo varovaisesti yrittänyt lähestyä, mutta siitä on jo aikaa. Jos tunnet171233- 681191
- 220988
- 70815
- 45750
Miksi homous puhuttaa konservatiiveja vuodesta toiseen?
Kysymykseen on vastattukin Kansanlähetyksen osalta: "Miksi sukupuoleen ja seksuaalisuuteen liittyvät asiat ovat konserv194723