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

841

    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. Moikka rakas

      Oon miettinyt meidän välistä yhteyttä viime aikoina. En ihan osaa pukea sanoiksi, mitä kaikkea tunnen, mutta halusin vaa
      Ikävä
      20
      5974
    2. Malmin tapaus on järkyttävä

      Kolme ulkomaalaistaustaista miestä raiskasi nuoren tytön tavalla, jota ei meinaa uskoa todeksi. Mikä voisi olla oikeampi
      Maahanmuutto
      554
      2154
    3. Mitä haluaisit kysyä

      Kaivatultasi?
      Ikävä
      146
      1778
    4. Mitkä asiat teidän elämässänne on

      Tällä hetkellä parasta?
      Ikävä
      82
      1174
    5. HS: Kuka vielä uskaltaa mennä sairaalan ensiapuun?

      https://www.hs.fi/mielipide/art-2000011212025.html Tässä on hyvin ajankohtainen mielipidekirjoitus koskien Malmin sairaa
      Maailman menoa
      97
      942
    6. Mitä haluaisit nähdä

      Kaivatullasi päällä?
      Ikävä
      72
      930
    7. Ökyrikas Kurkilahti mussuttaa veroistaan

      Pakeni aikoinaan veroja Portugaliin mutta joutui palaamaan takaisin kun Suomi teki verotussopimuksen Portugalin kanssa.
      Maailman menoa
      69
      826
    8. Jos tämän vaan sulkee ja avaa 5 vuoden päästä

      Täällä on luultavasti edelleen näitä ihan samoja juttuja. On kuin kauniit ja rohkeat samat jutut junnaa. Heips. 👋🏻 E
      Ikävä
      10
      783
    9. Kaupunki ostaa Kauppamatin

      Joutuukohan yrittäjät lähteen muualle?
      Haapavesi
      30
      774
    10. Kuntoportaat sai rahaa

      Kuntoportaat sai mojovan tuen. Minua vain ihmetyttää, tuleeko ne pidettyä käyttökunnossa. Televisiossa oli yksi aamu p
      Hyrynsalmi
      37
      696
    Aihe