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

897

Äänestä

    Vastaukset 7

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • kunde

      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

      • kunde
        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ä.

      • kunde
        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ä.

    Takaisin ylös

    Luetuimmat keskustelut

    1. Ampuminen kylpylässä

      Onko vornasen timbe käynyt hiukan kylpemässä vai mikä tämä ampumatapaus on kylpylässä? Tuntuu aika villi meno olevan naa
      Naantali
      50
      1188

    2. Moottoripyöräonnettomuus

      Mopomiitissä tapahtunut onnettomuus ja uutisointi. Ajoradan ylityksen vaarallisuudesta ei mitään uutisointia. Ei myöskää
      Alajärvi
      84
      925

    3. haluatko lopettaa

      ihan lopullisesti
      Ikävä
      164
      887

    4. Jos oikeasti haluat mies

      Tiedät mitä on tehtävä. Luotan, että etenet jos haluat. En voi tehdä enää mitään kun ei ole numeroasi.
      Ikävä
      105
      834

    5. Uusi ruokapaikka

      Tuleeko Haapavedelle uusi lounaspaikka ,haetaan kokkia? Uusi firma kyseessä
      Haapavesi
      29
      795

    6. Kerro minulle totuus

      Minä haluan kuulla sen nyt. Kenen kanssa sinä olet nykyisin, ja miksi jätit minut? 🐒
      Ikävä
      197
      720

    7. Miten sinä voit?

      Kysytkö kukaan sitä sinulta? Olen huomannut, että jos kohtaa empaattisen ihmisen ja hän kysyy noin, saattaa padot murtua
      Ikävä
      93
      697

    8. Hautakivien massapoisto aloitettu Härkökankaan vanhalla hautausmaalla kaikessa hiljaisuudessa!

      Suomussalmen seurakunnan kirkkoneuvosto on tehnyt historiansa surullisimman päätöksen hautojen haltuunotosta ja raivauks
      Suomussalmi
      42
      683

    9. voi luoja kun uskaltaisin

      laittaa viestiä sinulle...
      Ikävä
      25
      637

    10. Kemijärvellä vesionnettomuus

      Pitkänsillan ja taiteilijanniemen välillä nähty henkilön painuvan veden alle. Mitä on tapahtunut? Onko vesihiisi taas as
      Kemijärvi
      24
      629

    11. Hei, voitko kuunnella

      Voisitko auttaa minua selvittämään asioita? En halua ajaa sinua hulluuteen kanssani, en sitoa sinua, en esittää vaatimu
      Ikävä
      122
      625

    12. Miten yrität

      Vielä saada kaivattusi?
      Ikävä
      61
      602

    13. VILLISIKALAUMA TULOSSA IISALMEEN

      Yle: Poliisi varoittaa Iisalmen keskustaa lähestyvästä villisika­laumasta Poliisi on pyytänyt Pohjois-Savossa Iisalmessa
      Iisalmi
      43
      586

    14. Useita poliisiautoja kunnantalolla

      Maijojen kyydissä tuttuja naamoja ja nyt kannetaan arkistolaatikoita autoihin. Nyt se on alkanut. Pidätykset.
      Ähtäri
      12
      545

    15. On todella ikävää

      Todella ikävää, että asiat ovat menneet tällaisiksi. Tämä ei ollut missään vaiheessa tarkoitukseni. Olen tehnyt virheit
      Ikävä
      78
      520

    16. Jos näkisimme vielä joskus

      ... mihin veisit miut treffeille? 😊
      Ikävä
      79
      502

    17. Tiedätkö ton lähilammen?

      🤔
      Ikävä
      39
      485

    18. Muutto auto hakee sut tänään!

      Tein sulle oman huoneen! mieheltä naiselle
      Ikävä
      57
      485

    19. sinulle....

      Olen ymmärtänyt, ettei minua haluta enää takaisin. Mitään pahaa en koskaan halunnut sinulle. Ikävä että kuvittelit niin.
      Ikävä
      75
      477

    20. Ottanet yhteyttä

      Facebookissa,jos on jotain asiaa.Miehelle! T.M-nainen.
      Ikävä
      55
      477
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt