Macro Problem

Oligo

2010-04-27 15:48:02

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 =(

388

Äänestä

Vastaukset 10

ettätälleen
2010-04-27 20:58:29
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
  2010-04-28 09:24:41
  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.
- kunde
  2010-04-28 11:30:30
  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
  2010-04-29 16:07:21
  kunde kirjoitti:
  lisäämällä toisen haun ja muuttelemalla solualueita toimiva versio...
  http://keskustelu.suomi24.fi/node/6001900#comment-31562054
  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
- kunde
  2010-04-30 04:23:16
  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
  2010-04-30 09:48:22
  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 Sub
  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!
- kunde
  2010-04-30 11:31:59
  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
  2010-04-30 13:44:02
  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
  @Kunde
  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...
- Oligo
  2010-04-30 14:07:13
  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!
- kunde
  2010-04-30 14:45:29
  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ä.

Takaisin ylös

Luetuimmat keskustelut

Huomenta
Sinulle! Olen miettinyt sinua paljon yön aikana. 🫂
03.10.2026 09:18Ikävä
75
1221
Viesti sinulle
Tiedät että tunteet ja ajatukset ja meillä on vahva yhteys mistä molemmat tiedetään. Odotan sinua ☀️
04.10.2026 11:31Ikävä
47
930
Mitä ihmettä pitäisi tapahtua
Että me kohdataan ja saadaan tämä tilanne etenemään?
03.10.2026 16:17Ikävä
69
802
Olen kironnut sinut alimpaan helvettiin
Hyvää matkaa.
04.10.2026 11:10Ikävä
82
801
Mikä on totta mikä ei?
Onko juoru vai ei että nimeltä mainitsematon henkilö on tehnyt naiselle/naisille jotain joka on väärin?
05.10.2026 00:43Kuhmo
14
792
Jos mies naisen prinsessakohtelu
on sinulle liikaa, älä valitse prinsessaa 🦋🧚🏼‍♀️👸🏼
03.10.2026 06:38Ikävä
149
736
Mitä sinulle on tapahtunut lapsena
Kun olet noin sairas päästäsi? Pikkupojalle ( Miehen kehossa)
04.10.2026 13:02Ikävä
80
719
Ikävö sinua nainen!
Rakastan sua! ❤️💛❤️💜🧡🧡💚🤎:💜💜❤️
03.10.2026 23:25Ikävä
64
709
Miksi meille jäi
Niin huonot välit vaikka meistä kumpikaan ei ole tunteilleen mitään voinut. Ehkä se kohtalo on sitä mieltä ettei kuitenk
03.10.2026 12:53Ikävä
38
699
Tunteiden käsittely kertoo ihmisestä.
Kun puhutaan "tavallisesta" ihmisestä, joka on suht tasapainoinen eläjä, niin puhutaan oikeastaan taitavasta tunteiden k
04.10.2026 14:03Sinkut
202
596
Haluan purkaa vielä tuntemuksia
Tykkään sinusta kovin paljon❤️ olen surullinen tilanteestasi ja siitä mitä me olemme yhdessä joutuneet kokemaan. Tämä ei
04.10.2026 14:31Ikävä
19
595
Rakas, rakkaampi, rakkain
Olen tullut siihen johtopäätökseen, ettei minun kannata rakastaa. Kaikki joita olen koskaan rakastanut vain kohtelevat m
03.10.2026 18:18Sinkut
120
593
Kyllä tiedän sun
Likaiset pelit selän takana
04.10.2026 00:59Ikävä
52
549
Sara Sieppi ja hissi tänään
Voi helvetin helvetti. Nytkö tätä naikkosta täytyy palvoa ja antaa etuoikeus hissiin, kun hän on vääntänyt kakaran maail
03.10.2026 15:42Kotimaiset julkkisjuorut
115
535
Onko tuo joku katkera nainen oikeasti
Joka sinua syyttää?
04.10.2026 22:53Ikävä
90
518
Persujen Puhoksen retki
Perussuomalaiset olivat tehneet turistibussimatkan Puhokseen. Tosin raukat olivat niin peloissaan, etteivät uskaltaneet
04.10.2026 21:03Perussuomalaiset
169
514
Ketä ajattelen
kun mietin, mitä sinulle kuuluu? En tunne sinua oikeasti, ja se on ehkä hyvä, koska jos tietäisin enemmän, se varmaan v
03.10.2026 01:36Ikävä
18
500
Työttömän miehen ihmisarvo
..parisuhdemarkkinoilla on olematon. Työtön mies on naisille ihmisjätettä, varsinkin jos sattuu olemaan vielä kunnolline
03.10.2026 20:14Sinkut
116
497
YLINEN pilaa Ähtärin mahdollisuudet.
Vuodeosastopäätös jossa Nina Ylinen (sdp) äänesti niiden lopettamisen puolesta, hoitajille potkut ja silti arviointimene
03.10.2026 17:48Ähtäri
25
456
Pilkettä sunnuntain silmässä
😉 Jos tästä ketjusta löytyisi yksi ihminen, joka saisi sut hymyilemään tänään… Millainen hän olisi? Ei tarvitse kerto
04.10.2026 09:33Sinkut
65
451

Vastaukset 10

Oligo kirjoitti:

kunde kirjoitti:

Oligo kirjoitti:

kunde kirjoitti:

Oligo kirjoitti:

kunde kirjoitti:

Oligo kirjoitti:

Oligo kirjoitti:

Luetuimmat keskustelut

Huomenta

Viesti sinulle

Mitä ihmettä pitäisi tapahtua

Olen kironnut sinut alimpaan helvettiin

Mikä on totta mikä ei?

Jos mies naisen prinsessakohtelu

Mitä sinulle on tapahtunut lapsena

Ikävö sinua nainen!

Miksi meille jäi

Tunteiden käsittely kertoo ihmisestä.

Haluan purkaa vielä tuntemuksia

Rakas, rakkaampi, rakkain

Kyllä tiedän sun

Sara Sieppi ja hissi tänään

Onko tuo joku katkera nainen oikeasti

Persujen Puhoksen retki

Ketä ajattelen

Työttömän miehen ihmisarvo

YLINEN pilaa Ähtärin mahdollisuudet.

Pilkettä sunnuntain silmässä