Macro Problem

Oligo

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

10

388

Äänestä

    Vastaukset 10

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • 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.

      • kunde
        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-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
        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 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
        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
        @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
        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
        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

    1. Viesti sinulle

      Tiedät että tunteet ja ajatukset ja meillä on vahva yhteys mistä molemmat tiedetään. Odotan sinua ☀️
      Ikävä
      48
      1002

    2. Mikä on totta mikä ei?

      Onko juoru vai ei että nimeltä mainitsematon henkilö on tehnyt naiselle/naisille jotain joka on väärin?
      Kuhmo
      17
      949

    3. Olen kironnut sinut alimpaan helvettiin

      Hyvää matkaa.
      Ikävä
      82
      831

    4. Mitä sinulle on tapahtunut lapsena

      Kun olet noin sairas päästäsi? Pikkupojalle ( Miehen kehossa)
      Ikävä
      80
      749

    5. Haluan purkaa vielä tuntemuksia

      Tykkään sinusta kovin paljon❤️ olen surullinen tilanteestasi ja siitä mitä me olemme yhdessä joutuneet kokemaan. Tämä ei
      Ikävä
      21
      717

    6. Kyllä tiedän sun

      Likaiset pelit selän takana
      Ikävä
      59
      621

    7. Tunteiden käsittely kertoo ihmisestä.

      Kun puhutaan "tavallisesta" ihmisestä, joka on suht tasapainoinen eläjä, niin puhutaan oikeastaan taitavasta tunteiden k
      Sinkut
      203
      618

    8. Lopetetaanko tämä

      Juttu ja mennään eteenpäin? Pystytkö?
      Ikävä
      102
      584

    9. Persujen Puhoksen retki

      Perussuomalaiset olivat tehneet turistibussimatkan Puhokseen. Tosin raukat olivat niin peloissaan, etteivät uskaltaneet
      Perussuomalaiset
      188
      562

    10. Onko tuo joku katkera nainen oikeasti

      Joka sinua syyttää?
      Ikävä
      90
      538

    11. Jopa poliisi nauraa paskaista pelkuripersuille

      Puhoksessa jäi "isänmaantoivot" bussiin vapisemaan :-D https://www.is.fi/politiikka/art-2000012319632.html
      Maailman menoa
      255
      459

    12. 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
      Sinkut
      65
      451

    13. Just saying

      Mies joka antaa naiselle turvallisen olon, on seksikäs. Ei kieroja kikkoja ja haluaa olla vain sen yhden naisen mies.
      Ikävä
      81
      412

    14. Aika on tuonut järkeä

      Sä et tiedä musta kaikkea. Jos tietäisit, ymmärtäisit, miksi me ei sovita yhteen. Öljy ja vesi. En mä ole valehdellut,
      Järki ja tunteet
      42
      403

    15. Persut eivät uskaltaneet tulla ulos

      Bussiin jäivät https://www.iltalehti.fi/politiikka/a/d7f9fc57-dca0-40b8-9cb1-156e5872dba9
      Perussuomalaiset
      141
      367

    16. Voisin antaa sulle nyt

      Halin❤️
      Ikävä
      43
      362

    17. Tehdään yhdessä itsestämme

      Parhaat versiot❤️ Se vaatii molemmilta hyvää itsetuntoa!
      Ikävä
      29
      360

    18. Onko muka 21 vuoden ikäero paljon?

      🤔
      Rakkaus ja rakastaminen
      26
      356

    19. Ketkä käy potkimassa ovia öisin?

      Enää ei naurata.
      Haapavesi
      4
      349

    20. Miten viikonloppu meni

      Mielestäsi? Tapasitko kaivatun? Jos, etenivätkö asiat?
      Ikävä
      29
      348
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt