Löytyykö merkkijono-->kopioi rivi sheet2

G2-op

Osaako joku neuvoa?

Minulla on taulukko, jossa on rivejä n. 500 kpl ja riveillä 2-50 sarakkeita, joilla on merkkijonoja.

Haluan etsiä koko taulukosta rivi riviltä löytyykö tiettyä merkkijonoa joltakin sarakkeelta. Jos löytyy haluan kopioida kyseisen rivin sisällön kokonaisuudessaan toiseen taulukkoon ja jatkaa etsintää viimeiselle riville asti.

7

834

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • moduuliin...
      etsii nyt sheet1:stä arvoa 11 ja siirtää löydetyt rivit sheet2:lle ekalle tyhjälle riville A- sarakkeessa
      muuttele vakioita tarpeesi mukaan...
      LookIn:=xlValues-xlFormulas
      LookAt:=xlWhole-xlPart
      MatchCase:=False-True

      Function EtsiJaSiirrä(Hakuehto As Variant) As Range
      Dim solu As Range
      Dim EkaOsoite As String
      Worksheets("Sheet1").Activate
      With Cells
      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
      On Error GoTo virhe
      Set Löydetty = EtsiJaSiirrä(11).EntireRow
      Union(Löydetty, Löydetty).Copy Range("Sheet2!A65536").End(xlUp).Offset(1, 0).EntireRow
      Exit Sub
      virhe:
      MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
      End Sub

      • mokasin

        mulla pysätyy tohon LookIn:= kohtaan

        mitä teen väärin

        sen lisäksi koitin muokata siten että hakee sheet1 A1 solun tietoa Sheet3 ja palauttaa Sheet1 A1 alapuolelle jos löytyy, haku on tekstiä, ja jos löytyy useampia, palauttaisi kaikki allekkain sheet1 sivulle

        LookIn:=xlValues - xlFormulas
        LookAt = xlWhole - xlPart
        MatchCase = False - True

        Function EtsiJaSiirrä(Hakuehto As Variant) As Range
        Dim solu As Range
        Dim EkaOsoite As String
        Worksheets("Sheet3").Activate
        With Cells
        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
        On Error GoTo virhe
        Set Löydetty = EtsiJaSiirrä(R1C1).EntireRow
        Union(Löydetty, Löydetty).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
        Exit Sub
        virhe:
        MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
        End Sub


      • mokasin kirjoitti:

        mulla pysätyy tohon LookIn:= kohtaan

        mitä teen väärin

        sen lisäksi koitin muokata siten että hakee sheet1 A1 solun tietoa Sheet3 ja palauttaa Sheet1 A1 alapuolelle jos löytyy, haku on tekstiä, ja jos löytyy useampia, palauttaisi kaikki allekkain sheet1 sivulle

        LookIn:=xlValues - xlFormulas
        LookAt = xlWhole - xlPart
        MatchCase = False - True

        Function EtsiJaSiirrä(Hakuehto As Variant) As Range
        Dim solu As Range
        Dim EkaOsoite As String
        Worksheets("Sheet3").Activate
        With Cells
        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
        On Error GoTo virhe
        Set Löydetty = EtsiJaSiirrä(R1C1).EntireRow
        Union(Löydetty, Löydetty).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
        Exit Sub
        virhe:
        MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
        End Sub

        Set Löydetty = EtsiJaSiirrä(R1C1).EntireRow
        ei tunnista tota R1C1 soluksi A1, all hiukan muunneltuna ja korjattuna makrot


        Function EtsiJaSiirrä(Hakuehto As Variant) As Range
        Dim solu As Range
        Dim EkaOsoite As String
        Worksheets("Sheet3").Activate
        With Cells
        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
        Worksheets("Sheet1").Activate
        Range("A1").Select
        End Function

        Sub Testi()
        Dim Löydetty As Range
        Dim Haku As Variant

        On Error GoTo virhe
        Haku = Worksheets("Sheet1").Range("A1")
        Set Löydetty = EtsiJaSiirrä(Haku).EntireRow
        Union(Löydetty, Löydetty).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
        Exit Sub
        virhe:
        MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
        End Sub


      • konsultointia
        kunde kirjoitti:

        Set Löydetty = EtsiJaSiirrä(R1C1).EntireRow
        ei tunnista tota R1C1 soluksi A1, all hiukan muunneltuna ja korjattuna makrot


        Function EtsiJaSiirrä(Hakuehto As Variant) As Range
        Dim solu As Range
        Dim EkaOsoite As String
        Worksheets("Sheet3").Activate
        With Cells
        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
        Worksheets("Sheet1").Activate
        Range("A1").Select
        End Function

        Sub Testi()
        Dim Löydetty As Range
        Dim Haku As Variant

        On Error GoTo virhe
        Haku = Worksheets("Sheet1").Range("A1")
        Set Löydetty = EtsiJaSiirrä(Haku).EntireRow
        Union(Löydetty, Löydetty).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
        Exit Sub
        virhe:
        MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
        End Sub

        Kiitti Kunde.

        Jäi laittamatta että A1 kenttään tulee tekstiä, ja vastaus / vastauksia tulisi vaikkei olisikaan kirjoittanut täysin samalla tavalla ( isot /pienet kirjaimet ) ja täydellistä sanaa, esim viiden kirjaimen mukaan, muttei välttämättä lauseen / rivin alussa vaan jossain sen sisällä.


      • konsultointia kirjoitti:

        Kiitti Kunde.

        Jäi laittamatta että A1 kenttään tulee tekstiä, ja vastaus / vastauksia tulisi vaikkei olisikaan kirjoittanut täysin samalla tavalla ( isot /pienet kirjaimet ) ja täydellistä sanaa, esim viiden kirjaimen mukaan, muttei välttämättä lauseen / rivin alussa vaan jossain sen sisällä.

        kuten ekassa postauksessani sanoin, vaihda vakioita
        vauhda koodissa
        LookAt:=xlWhole--->LookAt:=xlPart


      • Kumarrus
        kunde kirjoitti:

        kuten ekassa postauksessani sanoin, vaihda vakioita
        vauhda koodissa
        LookAt:=xlWhole--->LookAt:=xlPart

        Nyt pelittää, mutta

        vielä jos saa niin ettei väliä onko capslock päällä.
        Jos kirjoitan ISOILLA toimii
        pienillä ei löydy


      • kiitos kundelle
        Kumarrus kirjoitti:

        Nyt pelittää, mutta

        vielä jos saa niin ettei väliä onko capslock päällä.
        Jos kirjoitan ISOILLA toimii
        pienillä ei löydy

        toimii jo olin muuttanut noi trueksi, vaihdoin takaisin.

        MatchCase:=False,
        _
        SearchFormat:=False

        olen sulle kaljan ainakin velkaa

        kiitos


    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Luetuimmat keskustelut

    1. JOKO OLETTE KUULLET, MITÄ KIURUVEDELLÄ ON SATTUNUT!

      Oletteko jo kuulleet, mitä Kiuruvedellä on sattunut, voi hyvänen aika? Aivan viime tuntien aikana olisi sattunut, jos t
      Kiuruvesi
      33
      11625
    2. Hetken jo luulin, että en ikävöi sinua koko aikaa

      Mutta nyt on sitten taas ihan hirveä ikävä jotenkin. Tiedätköhän sinä edes, kuinka peruuttamattomasti minä olen sinuun r
      Ikävä
      35
      7501
    3. V*ttuu että mä haluan sua

      Jos jotain ihmistä voi kunnolla haluta, niin hän on se. Voi Luoja auta jo! Joku jeesus hjelppa mej!
      Ikävä
      82
      3929
    4. Nolointa ikinä miehelle

      On ghostata nainen jonka kanssa on ollut ystävä tai ollu orastavaa tapailua pidemmän aikaa. Osoittaa sellaista moukkamai
      Ikävä
      106
      3829
    5. Katsoitko mua yhtään

      Kun nähtiin 🥺.
      Ikävä
      43
      3371
    6. Outoa että Trump ekana sanoutui irti ilmastosopimuksesta

      kun Kaliforniaa riepottelee siitä johtuvat tuhoisat maastopalot. Hirmumyrskytkin ovat USA:ssa olleet tuhoisia.
      Maailman menoa
      611
      3237
    7. Eli jos toisen hiki haisee ns. omaan nenään siedettävältä

      Se kertoo hyvästä yhteensopivuudesta. Selvä! Olet mies minun. 🫵🥳
      Ikävä
      52
      3212
    8. Mikä sinua eniten

      Huolestuttaa tässä tilanteessa?
      Ikävä
      91
      3098
    9. Sattuma ja muutama väärinkäsitys

      vaikuttivat siihen millaiseksi tämä kaikki muodostui. Pienet aikanaan huomaamattomat käänteet. Seuraava näytös on jo tul
      Ikävä
      32
      2033
    10. Koska olet viimeksi nähnyt ikävän kohteesi?

      Ja mitä tarjoat hänelle kun koputtaa oveesi?
      Ikävä
      36
      1910
    Aihe